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Software  Engineering  Institute 


Welcome  to  the  Software  Engineering  Institute.  I'd  like  to  extend  my  greetings  and  express  the 
hope  that  your  visit  is  informative,  pleasant,  and  productive. 

It  this  is  your  first  contact  with  the  SEI,  you  may  be  interested  in  the  following  background 
information.  The  Software  Engineering  Institute  is  a  federally  funded  research  and  development 
center  (FFRDC).  Our  organization  was  formed  in  1984  in  response  to  the  need  for  advances 
across  all  phases  of  the  software  engineering  process.  It  is  operated  by  Carnegie  Mellon 
University,  under  contract  with  the  Department  of  Defense.  Our  main  directives  include  bringing 
the  ablest  professional  minds  and  the  most  effective  technology  to  bear  on  the  rapid  improvement 
of  the  quality  of  operational  software  in  mission-critical  computer  systems,  exploring  and 
disseminating  technology,  and  establishing  standards  of  excellence  for  software  engineering 
practice. 

We  concentrate  most  of  our  effort  on  technology  transition,  although  we  are  actively  involved  with 
technology  generation  as  well.  Our  approach  is  to  shift  software  engineering  from  a  labor- 
intensive  basis  to  a  technology-intensive  basis  through  automation  based  on  sound  models  and 
theories,  and  to  concentrate  on  technology  transition  throughout  the  managerial,  professional, 
legal,  economic,  and  computational  facets  of  software  engineering.  Programs  at  the  SEI  provide 
a  framework  for  coordinated  efforts  within  defined  areas  of  technology.  They  build  a  foundation 
to  support  continued  improvement  in  an  area  of  technology,  to  develop  SEI  expertise,  and  to 
facilitate  the  transition  of  technology  arJ  information  into  practice. 

I  hope  your  visit  exceeds  your  expectation. 


Carnegie  Mellon  University 
Pittsburgh.  Pennsylvania  15213 
(412)268-7700 


Ada  Software  Engineering 
Education  and  Training  (ASEET)  Team 
Advanced  Ada  Workshop 
Software  Engineering  Institute 
12-15  January  1988 
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ADVANCED  Ada  WORKSHOP 
Software  Engineering  Institute 
12-15  January  1988 

SCHEDULE 

Tuesday,  12  January  1988 


3:00 

Welcoming  Remarks 

Training  Room  A 

3:15 

Introduction 

Major  Allan  Kopp 

AJPO  Representative 

3:00 

Tutorial  -  Software  Engineering 

Capt.  Roger  Beauman-Keesler  AFB 

10:00 

Break 

10:15 

Tutorial  -  Software  Engineering 

Capt.  Roger  Beauman  -  Keesler  AFB 
Capt.  Michael  Simpson  -  Keesler  AFB 

12:00 

Lunch 

1:30 

Tutorial  -  Software  Engineering 

Capt.  Roger  Beauman  -  Keesler  AFB 
Capt.  Michael  Simpson  -  Keesler  AFB 

3:00 
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3:15 

Tutorial  -  Software  Engineering 

Capt.  Roger  Beauman  -  Keesler  AFB 
Capt.  Michael  Simpson  •  Keesler  AFB 

5:00 

End  of  Session 
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WEDNESDAY,  13  JANUARY  1988 


Training  Room  A 


8:30  Tutorial  -  Packages 
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10:15  Tutorial  -  Packages 


Mr.  John  Bailey  •  IDA  Consultant 


Mr.  John  Bailey  •  IDA  Consultant 


12:00  Lunch 


1 :3Q  Tutorial  -  Exceptions 


Major  Pat  Lawlis  -  AFIT 


3:00  Break 


3:15  Tutorial  ■  Exceptions 


Major  Pat  Lawlis  -  AFIT 


5:00  End  of  Session 


7:00  •  9:00  Birds  of  a  Feather 


Ada  Information  Clearinghouse 
and  ASEET  Materials  Library 


Thursday,  14  January  1988 


8:30  Tutorial  -  Tasking 


10:00  Break 


Training  Room 

Capt.  David  Cook  -  Air  Force  Academy 


10:15  T utorlal  -  Tasking 


12:00  Lunch 


1 :30  T utorlal  -  Taskl  ng 


Capt.  David  Cook  -  Air  Force  Academy 


Capt.  David  Cook  -  Air  Force  Academy 


3:00  Break 


3:15  Tutorial  -  Tasking 

5:00  End  of  Session 


Capt.  David  Cook  -  Air  Force  Academy 


7:00  -  9:00  Birds  of  a  Feather 
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Friday,  15  Janaury  1988 

Training  Room  A 


8:30 

Tutorial  -  Generics 

LCDR  Llndy  Moran  *  US  Naval  Academy 
Major  Chuck  Engle  -  SEI 

10:00 

Break 

10:15 

Tutorial  -  Generics 

LCDR  Llndy  Moran  -  US  Naval  Academy 
Major  Chuck  Engle  -  SEI 

12:00 

Lunch 

1:30 

Tutorial  -  Generics 

LCDR  Llndy  Moran  -  US  Naval  Academy 
Major  Chuck  Engle  •  SEI 

3:00 

Break 

3:15 

Tutorial  -  Generics 

LCDR  Llndy  Moran  -  US  Naval  Academy 
Major  Chuck  Engle  -  SEI 

5:00 

End  of  Session 

•Ada  IS  A  REGISTERED  TRADEMARK  OF  THE  U.S.  GOVERNMENT  (Ada  JOINT  PROGRAM  OFFICE). 


Ada®  REQUIREMENTS  DEFINED  IN  A 
SERIES  OF  DRAFT  SPECIFICATIONS 
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STANDARDIZATION 
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Ada  Compiler  Validation  Procedures  and  Guidelines 
coordinates  contractor  and  program  office  software 
acquisition/maintenance  actions  with  Ada  validation 


Validated  Ada  Compilers  (1983  - 1987) 
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•  VALIDATION  COMPILER  LIST  -  GENERAL  INFO 

-  EDUCATION 

•  Ada  IMPLEMENTATIONS  LIST  -  VALIDATION 

-  HISTORICAL 

•  CALENDAR  OF  Ada  EVENTS  -  CURRENT  AWARENESS 
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•  AdalC  provides  up  to  date  information  to  program 
offices  on  the  availability  of  Ada  technologies  for  use 
on  DoD  systems 


ACADEMIC  ACTIVITIES:  Ada  TECHNOLOGY  CENTER.  EDUCATIONAL 

SYMPOSIUM 
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•  Assisting  program  offices  in  requesting  vendors  to 
correct/improve  Ada  Technology  performance  (SAC) 

•  Sponsoring  ARTEWG  to  focus  industry  on  realtime 
performance  issues  to  support  Ada  use  in  embedded 


TECHNOLOGY  INSERTION 
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USED  FOR  SIMULATION,  CALIBRATION  OR  RESEARCH  & 
DEVELOPMENT 

APPLIES  TO  ALL  PHASES  OF  THE  LIFE  CYCLE  AND  MAJOR  UPGRADES 
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demonstrate  this  technology  on  the  products  resulting  from  this  effort;  and 

c.  develop  the  requirements  and  specifications  of  an  interface  standard 
for  APSEs,  based  on  reviews  of  evolutionary  interface  developments  to  be 
recommended  for  adoption  and  use  by  NATO  and  the  participating  nations. 
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Expanding  Acquisition/Maintenance  Management 
structure  to  support  Ada  in  DoD  Directives  and  Mil-S 
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-  Assisting  FAA  in  selecting  Ada  for  Advanced 
Automated  System 

-  Assisting  Dept  of  Commerce  in  selecting  Ada  for 
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APPLIED  Ada  SOFTWARE  ENGINEERING 

*  Basic  Problea 

—  Projection  to  the  1990's 
—  A  Macro  Solution 

*  A  Practical  Solution 

—  Software  Engineering 
—  Ada 

*  Software  Engineering 
—  Goals 

—  Principles 

*  Why  Ada  T 

—  Features  of  Ada 

—  Software  Engineering 
Applications 


BASIC  PROBLEM 

Projection  to  the  1990's 

*  Multiprocessors  —  Networks  and 
Parallel  Architectures 

*  Distributed  Databases 

*  Hardware  Capabilities 

*  Software  Deaands 

*  Hardware  Costs 
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DISTRIBUTED  DATABASES 


*  Central  Control  Over  Data 

*  Minimize  Effort  in  Storing  Dat 

*  “The  Ada  Package  Store* 
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HARDWARE  CAPABILITIES 


Mainfraae  in  a  Micro 

—  Intel  80286,  80386,  80486,  ??? 

—  Motorola  68000,  68010,  68020,  68030 
Screen  Resolution 

—  Desktop  Publishing,  CAD/CAM 
Storage  Devices 

—  100+  MB  Hard  Disks 

—  Access  Tlaes  -  18  as  to  40  ma 
Opens  New  Fields  of  Applications 


SOFTWARE  DEMANDS 
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*  New  Users  with  Consuier  Relationships 
.  *  Non-Technical  Arenas 


—  Need  Guarantees 


—  Demand  Reliability 
*  Development  is  the  Key 
—  Design  is  Paramount 

-  Simplistic  Operations;  i.e, 


—  Costs  of  Errors 


—  Other  Considerations 


A  MACRO  SOLUTION 


A  PRACTICAL  SOLUTION 
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Software  Engineering  Myths 

Anyone  Can  Be  a  Software  Engineer 
Automated  Tools  **  Software  Engineering 
Structured  Programming  -  Software  Engineering 
Structured  Analysis  ■  Software  Engineering 
Code  Re-use  “  Software  Engineering 
It  Will  Make  Programming  Obsolete 
AI  Will  Make  It  Effortless 
Fantastic  Productivity  Gains 
Ada  “  Software  Engineering 
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Software  professionals 


THE  FUNDAMENTAL  PROBLEM 


SOFTWARE  ENGINEERING 
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*  Principles 
Concepts 


SOFTWARE  ENGINEERING 


SOFTWARE  ENGINEERING 


THROUGHOUT  THE  LIFE  CYCLE  OF  A  SYSTEM 


TWARE  ENGINEERING 
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PROGRAMMING  LANGUAGES 
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The  quality  of  a  programming  language  for 
software  engineering  is  determined  by-how  well 
it  supports  a  design  methodology  and  its 
underlying  models,  principles,  and  concepts 


TRADITIONAL  PROGRAMMING  LANGUAGES 
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A  PRACTICAL  SOLDTION 

Ada 

Ada  and  Software  Engineering 

*  They  Aren't  the  Sane  Thing 

*  Ada  Has  Unique  Features  That 
Facilitates  Software  Engineering 

*  You  CAM  Vrlte  Bad  Code  In  Ada 

*  Ada  1 8  HOT  the  Total  Answer 
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STANDARDS  TOOLS 

CONCEPTS 
G  U  !  D  L  I  N  E  S  PRINCIPLES 

MODELS 

PRACTICES  METHODOLOGIES 
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SOFTWARE  ENGINEERING 

*  Goals  of  Software  Engineering 

*  Principles  of  Software  Engineering 
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PRINCIPLES  OF  SOFTWARE  ENGINEERING 


LOCALIZATION 


REQUIREMENTS  FOR  EFFECTIVE 
SYSTEMS  ENGINEERING 


Strong  Typing  Low  Level  Features 
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-e  is  a  clear  distinction  between  architecture 
implementation 


SEPARATE  COMPILATION 


SEPARATE  COMPILATION 


DISCRETE  COMPONENTS 


*  Prevalent  across  engineering  disciplines 


SUBPROGRAMS 
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Gives  abilitv  to  express  abstract  actions 


MAJOR  FEATURES  OF  Ada 


* 

Packages 

* 

Tasks 

* 

Strong  Typing 

* 

Exceptions 

* 

Typing  Structures 

* 

Generics 

* 

Data  Abstraction 

PACKAGES 
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NEW-LINE; 
end  loop; 
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Comparison 


<• 


-  the  American  way 


-  using  exceptions 
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A  run  time  error 


An  unusual  or  unexpected  condition 


A  condition  requiring  special  attention 


Other  than  normal  processing 


An  important  feature  for  debugging 


A  critical  feature  for  operational  software 


An  exception  has  a  name 


may  be  predefined 


may  be  declared 


•  The  exception  is  raised 


may  be  raised  implicitly  by  run  time  system 


-  may  be  raised  explicitly  by  raise  statement 


The  exception  is  handled 


-  exception  handler  may  be  placed  in  any  frame 


-  exception  propagates  until  handler  is  found 


if  no  handler  anywhere,  process  aborts 


*  executable  part  surrounded  by  begin  -  end 


■r.A  s. 


Thy  American  way 


package  Stack_Package  is 

type  Stack_Type  is  limited  private; 

:  in  out  Stack_Type; 

:  in  ElementJType; 

:  out  BOOLEAN); 


procedure  Push  (Stack 

Element 

Overflow_Flag 


end  Stack_Package; 


with  TEXT  IO; 

with  Stack_Package;  use  Stack^Package; 
procedure  Flag_Waving  is 

■  ■  ■ 

Stack  :  Stack_Type; 

Element  :  Element_Type; 

Flag  :  BOOLEAN; 

begin 


Push  (Stack,  Element,  Flag); 
if  Flag  then 

TEXTJO.PUT  ("Stack  overflow"); 


end  if; 

a  ■  • 

end  Flag_Waving; 


package  Stack_Package  is 


type  Stack_Type  is  limited  private; 

Stack_Overfiow, 

Stack_Underflow  :  exception; 

procedure  Push  (Stack  :  in  out  Stack_Type; 

Element  :  in  Element_Type); 

-  may  raise  Stack_Overflow 

» •  • 

end  Stack_Package; 

with  TEXTJO; 

with  Stack_Package;  use  Stack_Package; 
procedure  More_Natural  is 
•  •  • 

Stack  :  Stack_Type; 

Element :  E!ement_Type; 

begin 

•  ■  • 

Push  (Stack,  Element); 

•  ■  • 

exception 

when  Stack_Overflow  => 

TEXTJO.PUT  ("Stack  overflow"); 

end  More_Natural; 


Overview 


>  Naming  an  exception 


Creating  an  exception  handier 


Raising  an  exception 


Handling  exceptions 


Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


Summary 


In  package  STANDARD  (also  see  chap  11  of  LRM) 

CONSTRAINT_ERROR 

violation  of  range,  index,  or  discriminant  constraint.. 

NUMERIC_ERROR 

execution  of  a  predefined  numeric  operation  cannot 
deliver  a  correct  result 

PROGRAM_ERROR 

attempt  to  access  a  program  unit  which  has  not  yet 
been  elaborated... 

STORAGE_ERROR 

storage  allocation  is  exceeded... 

TASKING_ERROR 

exception  arising  during  intertask  communication 


i 
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exception_declaration  ::=  identifierjist :  exception; 


Exception  may  be  declared  anywhere  an  object  declaration 
is  appropriate 


However,  exception  is  not  an  object 

-  may  not  be  used  as  subprogram  parameter,  record 

or  array  component 

-  has  same  scope  as  an  object,  but  its  effect  may 

extend  beyond  its  scope 


Example: 


procedure  Calculation  is 


Singular 

Overflow,  Underflow 


:  exception; 
:  exception; 


begin 


end  Calculation; 


•  Exceptions  relating  to  file  processing 


In  predefined  library  unit  IO_EXCEPTIONS 
(also  see  chap  14  of  LRM) 


TEXTJO,  DIRECT  JO,  and  SEQUENTIALJO  with  it 


package  IO_EXCEPTIONS  is 


NAME_ERROR  :  exception; 
USE_ERROR  :  exception; 

STATUS_ERROR  :  exception; 
MODE_ERROR  :  exception; 
DEVICE_ERROR  :  exception; 
END_ERROR  :  exception; 

DATA_ERROR  :  exception; 

LAYOUT_ERROR  :  exception; 


-attempt  to  use 
-invalid  operation 


-attempt  to  read 
-beyond  end  of  file 
-attempt  to  input 
-wrong  type 
-for  text  processing 


endIO  EXCEPTIONS; 
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Overview 


Naming  an  exception 


>  Creating  an  exception  handler 


Raising  an  exception 


Handling  exceptions 


Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


Summary 


Defining  an  Exospfera  Handter 


•  Exception  condition  is  "caught"  and  "handled"  by  an  exception 
handler 


•  Exception  handler  may  appear  at  the  end  of  any  frame  (block, 
subprogram,  package  or  task  body) 


begin 

exception 

-  exception  handler(s) 
end; 


•  Form  similar  to  case  statement 


exception_handler  ::= 

when  exception_choice  (|  exception_choice}  => 
sequence_of_statements 

exception_choice  exception_name  |  others 
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Exception  handlers  must  be  at  the  end  of  a  frame 


Nothing  but  exception  handlers  may  lie  between  exception 
and  end  of  frame 


A  handler  may  name  any  visible  exception  declared  or 
predefined 


A  handler  includes  a  sequence  of  statements 
-  response  to  exception  condition 


A  handler  for  others  may  be  used 

-  must  be  the  last  handler  in  the  frame 

-  handles  all  exceptions  not  listed  in  previous 

handlers  of  the  frame 

(including  those  not  in  scope  of  visibility) 

-  can  be  the  only  handler  in  the  frame 


procedure  Whatever  is 


Problem_Condition  :  exception; 

begin 

exception 

when  Problem_Condition  => 
Fix_lt; 

when  CONSTRAINT_ERROR  = 
Report_lt; 

when  others  => 

Punt; 


end  Whatever; 


Overview 


•  Naming  an  exception 

•  Creating  an  exception  handler 

=>  Raising  an  exception 

•  Handling  exceptions 

•  Turning  off  exception  checking 

•  Tasking  exceptions 

•  More  examples 

•  Summary 


Elaboration  and  execution  exceptions 


How  exceptions  are  raised 


Effects  of  raising  an  exception 


Raising  example 
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Elaboration  and  ls?©,euit!i©m  Swaptions 

•  Elaboration  exceptions  occur  when  declarations  are  being 
elaborated 

-  after  a  unit  is  "called" 

-  before  execution  of  the  unit  begins 

-  can  only  be  predefined  exceptions 


•  Execution  exceptions  occur  during  execution  of  a  frame 


•  Elaboration  exceptions  can  also  be  considered  as  execution 
exceptions 


-  depending  on  viewpoint 

-  can  consider  as  part  of  the  execution  of  the  last 
executable  statement  making  the  call  to  the  unit 
being  elaborated 

-  this  helps  with  understanding  the  consistency  of 
the  rules  for  exception  handling 
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How  Exe©©iJ©ims  aor©  Ra: 


Implicitly  by  run  time  system 

-  predefined  exceptions 


Explicitly  by  raise  statement 


raise_statement  ::=  raise  [exception_name]; 


the  name  of  the  exception  must  be  visible  at  the 
point  of  the  raise  statement 

a  raise  statement  without  an  exception  name  is 
allowed  only  within  an  exception  handler 


procedure  Whatever  is 


Prob!em_Condition  :  exception; 

Real_Bad_Condition  :  exception; 


begin 


if  Problem_Arises  then 

raise  Problem_Condition; 

end  if; 

if  Serious_Problem  then 

raise  Real_Bad_Condition; 

end  if; 


exception 


when  Problem_Condition  => 
Fixjt; 

when  CONSTRAINT_ERROR  => 
Reportjt; 

when  others  => 

Punt; 


end  Whatever; 


Overview 


•R>: 


Naming  an  exception 


Creating  an  exception  handler 


Raising  an  exception 


=>  Handling  exceptions 


Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


Summary 
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•  Normal  processing  could  continue  if 


-  cause  of  exception  condition  can  be  "repaired" 

-  alternative  approach  can  be  used 

-  operation  can  be  retried 

•  Degraded  processing  could  be  better  than  termination 

-  for  example,  safety-critical  systems 


•  If  termination  is  necessary,  "clean-up"  can  be  done  first 


Which  ExccpTion  Hand  ter  Is  Used) 


When  exception  is  raised,  system  looks  for  an  exception 
handler  at  the  end  of  the  frame  being  executed 

If  exception  is  raised  during  elaboration  of  the  declarative 
part  of  a  unit  (unit  is  not  yet  ready  to  execute) 

-  elaboration  is  abandoned  and  control  goes  to  the 

end  of  the  unit  with  the  exception  still  raised 

-  exception  part  of  the  unit  is  not  searched  for  an 

appropriate  handler 

-  effectively,  the  calling  unit  will  be  searched  for  an 

appropriate  handler 

--  consistent  with  execution  viewpoint 

-  if  elaboration  of  library  unit,  program  execution  is 

abandoned 

--  all  library  units  are  elaborated  with  the 
main  program 

If  exception  is  raised  in  exception  handler 

-  handler  may  contain  block(s)  with  handler(s) 

-  if  not  handled  locally  within  handler,  control  goes 

to  end  of  frame  with  exception  raised 
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Occurs  if  no  handler  exists  in  frame  where  execution 
exception  is  raised 

Always  occurs  if  elaboration  exception  is  raised 
Also  occurs  if  raise  statement  is  used  in  handler 

Exception  is  propagated  dynamically 

-  propagates  from  subprogram  to  unit  calling  it 

(not  necessarily  unit  containing  its  declaration) 

-  this  can  result  in  propagation  outside  its  scope 

-  task  propagation  follows  same  principle,  but  a 

little  more  complicated 

Propagation  continues  until 

-  an  appropriate  handler  is  found 

-  exception  propagates  to  main  program  (still  with 

no  handler)  and  program  execution  is  abandoned 


procedure  Do_Nothing  is 

procedure  Hasjt  is 

Some_Problem  :  exception; 

begin 

raise  Some_Prob!em; 
exception 

when  Some_Problem  => 
CleanJJp; 
raise; 

end  Hasjt; 

procedure  Callsjt  is 
begin 

Hasjt; 
end  Callsjt; 
begin  -  DcjSlothing 
Callsjt; 
exception 

when  others  =>  Fix_Everything; 
end  Do_Nothing; 


Overview 


Naming  an  exception 


Creating  an  exception  handler 


Raising  an  exception 


Handling  exceptions 


=>  Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


Summary 


> 


Overhead  vs  efficiency 


Pragma  SUPPRESS 


Check  identifiers 


Exception  checking  imposes  run  time  overhead 

-  interactive  applications  will  never  notice 

-  real-time  applications  have  legitimate  concerns 

but  must  not  sacrifice  system  safety 

When  efficiency  counts 

-  first,  make  program  work  (using  good  design) 

-  be  sure  possible  problems  are  covered  by  exception 

handlers 

-  check  if  efficient  enough  -  stop  if  it  is 

-  if  not,  study  execution  profile 

-  eliminate  bottlenecks 

-  improve  algorithm 

-  avoid  "cute"  tricks 

-  check  if  efficient  enough  -  stop  if  it  is 

-  if  not,  trade-offs  may  be  necessary 

-  some  exception  checks  may  be  expendable  since 

debugging  is  done 

-  however,  every  suppressed  check  poses  new 

possibilities  for  problems 

-  must  re-examine  possible  problems 

-  must  re-examine  exception  handlers 

-  always  keep  in  mind 

-  problems  Mi  happen 

-  critical  applications  must  be  able  to 

deal  with  these  problems 
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Only  allowed  immediately  within  a  declarative  part  or 
immediately  within  a  package  specification 


pragma  SUPPRESS  (identifier  [,[  ON  =>]  name]); 


identifier  is  that  of  the  check  to  be  omitted 
(next  slide  lists  identifiers) 

name  is  that  of  an  object,  type,  or  unit  for  which 
the  check  is  to  be  suppressed 

-  if  no  name  is  given,  it  applies  to  the 
remaining  declarative  region 


An  implementation  is  free  to  ignore  the  suppress  directive 
for  any  check  which  may  be  impossible  or  too  costly  to 
suppress 


Example: 

pragma  SUPPRESS  (!NDEX_CHECK,  ON  =>  Index); 


iw**  n 


These  identifiers  are  explained  in  more  detail  in  chap  1 1  of 
the  LRM 


Check  identifiers  for  suppression  of  CONSTRAINT_ERROR 
checks 


ACCESSCHECK 
DISCRIMINANT_CHECK 
INDEX_CHECK 
LENGTH_CHECK 
RANGE  CHECK 


Check  identifiers  for  suppression  of  NUMERIC_ERROR  checks 

DIVISION_CHECK 

OVERFLOVVCHECK 


Check  identifier  for  suppression  of  PROGRAM_ERROR  checks 
ELABORATION  CHECK 


Check  identifier  for  suppression  of  STORAGE_ERROR  check 
STORAGE_CHECK 
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Exception  handling  is  trickier  for  tasks 


Exceptions  during  task  communication 


Tasking  example 


Exmpiim 


•  Rules  are  not  really  different,  just  more  involved 

-  local  exceptions  handled  the  same  within  frames 

If  exception  is  raised 

•  during  elaboration  of  task  declarations 

-  the  exception  TASKINGJERROR  will  be  raised  at  the 

point  of  task  activation  (becomes  execution 
exception  in  enclosing  subprogram) 

-  the  task  will  be  marked  completed 

•  during  execution  of  task  body  (and  not  resolved  there) 

-  task  is  completed 

-  exception  is  not  propagated 

•  during  task  rendezvous 

-  this  is  the  really  tricky  part 


37 


'vny  vjwji rjm  w%rn,  \r» 


Task  ©©mmyr#j©atj©n 


If  the  called  task  terminates  abnormally 

exception  TASKING_ERROR  is  raised  in  calling  task  at  the 
point  of  the  entry  call 


If  an  entry  call  is  made  for  entry  of  a  task  that  becomes 
completed  before  accepting  the  entry 

exception  TASKING_ERROR  is  raised  in  calling  task  at  the 
point  of  the  entry  call 


If  the  calling  task  terminates  abnormally 
no  exception  propagates  to  the  called  task 


If  an  exception  is  raised  in  called  task  within  an  accept  (and 
not  handled  there  locally) 

the  same  exception  is  raised  in  the  calling  task  at  the  point 
of  the  entry  call 

(even  if  exception  is  later  handled  outside  of  the  accept  in 
the  called  task) 
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procedure  Critical_Code  is 
Failure  :  exception; 


task  Monitor  is 

entry  Do_Something; 
end  Monitor; 
task  body  Monitor  is 

begin 

accept  Do_Something  do 

raise  Failure; 

end  Do_Something; 

exception  --  exception  handled  here 
when  Failure  => 

Termination_Message; 

end  Monitor; 


begin  -  Critical_Code 

Monitor.  Do_Something; 

exception  --  same  exception  will  be  handled  here 
when  Failure  => 

Critical_Problem_Message ; 


end  Critical  Code; 


s  s 


Overview 


•  Naming  an  exception 


•  Creating  an  exception  handler 


•  Raising  an  exception 


•  Handling  exceptions 


•  Turning  off  exception  checking 


*  Tasking  exceptions 


=>  More  examples 


•  Summary 
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Interactive  data  input 


Propagating  exception  out  of  scope  and  back  in 


Keeping  a  task  alive 


V**»ivyvi 


with  TEXT  JO;  use  TEXTJO; 

procedure  Getjnput  (Number :  out  integer)  is 

subtype  InputJType  is  integer  range  0..100; 
package  intjo  is  new  INTEGERJO  (InputJType); 
Injslumber :  InputJType; 

begin  --  Getjnput 

loop  --  to  try  again  after  incorrect  input 

begin  -  inner  block  to  hold  exception  handler 

put  ("Enter  a  number  0  to  100"); 

Intjo. GET  (InJMumber); 

Number  :=  ln_Number; 

exit;  --  to  exit  loop  after  correct  input 

exception 

when  DATA__ERROR  => 

put  ("Try  again,  fat  fingers!"); 
SkipJJne;  --  must  clear  buffer 

end;  --  inner  block 

end  loop; 


end  Getjnput; 


declare 

package  Container  is 

procedure  Has_Handler; 
procedure  Raises_Exception; 
end  Container; 


procedure  Not_in__Package  is 
begin 

Container.Raises_Exception; 

exception 

when  others  =>  raise; 
end  NotJn_Package; 


package  body  Container  is 
Crazy  :  exception; 
procedure  Has_Handler  is 
begin 

Not_in_Package; 

exception 

when  Crazy  =>  Tell_Everyone; 
end  Has_Handler; 
procedure  Raises_Exception  is 
begin 

raise  Crazy; 

end  Raises_Exception; 
end  Container; 

begin 

Container.  Has_Handler; 
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task  Monitor  is 

entry  Do_Something; 
end  Monitor; 

task  body  Monitor  is 
begin 

loop  --  for  never-ending  repetition 
•  • « 

select 

accept  Do_Something  do 

begin  --  block  for  exception  handler 

raise  Failure; 
exception 

when  Failure  =>  Recover; 
end;  --  block 

end  Do_Something;  --  exception  must  be 

-  lowered  before  exiting 

end  select; 

end  loop; 

exception 

when  others  => 

Termination_Message; 
end  Monitor; 


Overview 


Naming  an  exception 


Creating  an  exception  handler 


Raising  an  exception 


Handling  exceptions 


Turning  off  exception  checking 


Tasking  exceptions 


More  examples 


>  Summary 


Exception  handling  principles  are  consistent 

Suppression  of  exception  checking  will  usually  do  more  harm 
than  good 

Use  of  exceptions  must  become  a  habit  to  be  useful 
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4: 


task  (type]  [Is 

{ entry_declarat ion} 

{ represen tation_clause} 
end  [ task_s imple__narae]  ] 


task  body  task_simple_name  is 
[declarativ  e_pa  r  t ] 
begin 

[ sequence_of_statements] 
(exception 

except ion_handler 
{exception_handler } ] 
end  {task  simple  name]; 
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END  T 1 
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Task  T1  is 

ENTRY  ENTRY1; 

END  Tlj 

Task  body  T1  is 
begin 

LOOP 

accept  ENTRY1 ;  --'sync'  call  only 

<S0$> 

END  LOOP; 

END  T 1 ; 

--WAIT  FOREVER  FOR  CALL  TO  ENTRY1 


--EVEN  IF  ENT RY 1  HAS  PARAMETERS  ASSOCIATED  WITH 

IT,  THE  ACCEPT  BLOCK  DOES  NOT  HAVE  TO  HAVE  A 
SEQUENCE  OF  STATEMENTS 


SELECT  Statement 


Used  by  the  task  to  allow  options 

Simplest  form  is  the  selective  wait  (wait  forever) 

Task  T1  is 

ENTRY  ENTRYlj 
entry  ENTRY2; 

END  Tl; 


Task  body  Tl  is 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENTRY1  DO 

<s&$> 

END  ENTRYlj 

<$os> 

OR 

accept  ENTRY2  do 
<S0S> 

END  ENTRY2; 

<S0S> 

--AS  MANY  #OR'  AND  ACCEPT  CLAUSES  AS  NEEDED 


END  SELECT; 

END  LOOP; 

-WAIT  FOR  EITHER  ENTRY1  OR  ENTRY2 


Selective  wait  with  else  (don  t  wait  at  all) 


Task  T1  is 

entry  ENTRY1; 
END  Tlj 


« 

Task  body  T1  rs 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENTRY1  DO 

<sos> 

END  ENTRY1; 

<S0$> 

ELSE 

<S0S> 

END  SELECT; 

END  LOOP; 

END  Tl; 

If  THERE  IS  NOT  A  CALLER  WAITING  RIGHT  MOW, 
DO  THE  ELSE  PARY. 


Selective  wait  with  else,  multiple 
accepts 

Task  Tl  is 

entry  ENTRY1; 
entry  ENTRY2; 
end  Tl; 


Task  body  Tl  is 
begin 
loop 

SELECT 

accept  ENTRY1  do 
<S0S> 

END  ENTRY1; 

<S0S> 

OR 

accept  EMTRY2  do 

•  •  • 

--  AS  MANY  'OR'  AND  'ACCEPT'  CLAUSES  AS  NEEDED 
ELSE 

<  SOS  > ; 

END  SELECT; 

END  LOOP; 

END  Tl; 


ll 

A 


Select  with  delay  alternative 
(wait  a  finite  time) 

Task  body  Tl  is 

BEGIN 

LOOP 

SELECT 

ACCEPT  ENT RY1  DO-*** 

(  OR 

accept  ENTR Y2 . ) 

OR 

DELAY  15*0;  --SECONDS 
<S0S> ; 

END  SELECT; 

END  LOOP; 

END  Tl; 

If  ENTRY1  called  within  15  seconds, 

THEN  YOU  ACCEPT  THE  CALL*  OTHERWISE, 
AFTER  15  SECONDS  YOU  WILL  DO  SOMETHING' 


'DELAY'  Rules 

YOU  MAY  HAVE  SEVERAL  ALTERNATIVES 
WITH  A  DELAY  STATEMENT. 

Since  delays  can  be  static,  the  shortest 

DELAY  ALTERNATIVE  WILL  BE  SELECTED* 

Zero  and  negative  delays  are  Legal. 


You  may  not  have  an  else  part  with 
a  DELAY,  since  the  delay  would  never 

BE  ACCEPTED. 
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'DELAY'  Rules 


YOU  HAY  HAVE  SEVERAL  ALTERNATIVES 
WITH  A  DELAY  STATEMENT. 

Since  delays  can  be  static,  the  shortest 

DELAY  ALTERNATIVE  WILL  BE  SELECTED* 

Zero  and  negative  delays  are  Legal. 


You  MAY  NOT  HAVE  AN  ELSE  PART  WITH 
A  DELAY,  SINCE  THE  DELAY  WOULD  NEVER 
BE  ACCEPTED- 


•  _  *  ->  %  A  «  ,  «  "»  *>  A  .'V 


Select  with  delay  alternative 
(wait  a  finite  time) 

Task  body  T1  is 
begin 
loop 
select 

ACCEPT  ENTRY1  DO.... 

(  OR 

accept  EN7RY2 . ] 

OR 

delay  <expression>; 

<S0S> ; 

OR 

delay  <express i on>; 

<  SOS  > ; 

—  SHORTEST  DELAY  WILL  GET  CHOSEN 

END  SELECT; 

END  LOOP; 

END  Tl; 


5  , 


V 


Guards  can  be  used  on  any  accept 

STATEMENT 


WHEN  S0ME_C0NDI T I  ON  => 
accept  ENTRY 1  . 


If  there  is  no  GUARD,  the  accept  statement 
is  said  to  be  OPEN. 

If  there  is  a  GUARD,  and  the  WHEN  condition 
IS  TRUE,  THE  ACCEPT  IS  ALSO  OPEN* 

False  GUARD  statements  are  said  to  be  CLOSED. 

OPEN  alternatives  are  considered.  If  there  is 
more  than  one,  then  ONE  IS  SELECTED  ARBITRARILY. 

If  there  are  NO  OPEN  ALTERNATIVES  (and  no  else 
part),  the  exception  PROG RAM_ERR0R  is  raised. 


TERMINATION 


When  a  task  has  completed  its  sequence 

OF  STATEMENT S ,  ITS  STATUS  IS  COMPLETED 

Additionally,  there  is  an  option  that 

ALLOWS  A  TASK  TO  TERMINATE* 


SELECT 

ACCEPT  ENTRY1  DO  . 

(  OR 

accept  ENTRY2  do . ] 

OR 

TERMINATE; 

END  SELECT; 

This  may  not  be  used  with  either  the 
the  DELAY  or  an  ELSE  clause* 

Since  this  is  used  only  with  a  'wait  forever' 
task,  this  option  allows  a  task  that  is 
waiting  forever  to  terminate  if  its  parent 
is  also  ready  to  quit* 


Might  always  take  ENTRY  1  !!!! 
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task  SEMAPHORE  is 

ENTRY  P;  --GET  RESOURCE 
ENTRY  V;  --RELEASE 

end  SEMAPHORE; 

TASK  BODY  SEMAPHORE  IS 

AVAILABLE  :  BOOLEAN  :*  TRUE; 

BEGIN 

LOOP 

SELECT 

when  AVAILABLE 

ACCEPT  P  DO 

AVAILABLE  :  =  FALSE; 
END  P; 

OR 

when  not  AVAILABLE 

ACCEPT  V  DO 

AVAILABLE  :»  TRUE; 
END  V; 

OR 

TERMINATE; 

END  LOOP; 

END  SEMAPHORE; 


Task  Special  Ops  is 

entry  ASSIGN  (  Object  :  in  Some_Type  ); 
entry  RETRIEVE  (  Object  :  out  Some_Type); 
end  Special_Ops; 


Task  body  Special_Ops  is 
The.Object  :  Some_type; 
begin 
loop 
select 

accept  ASS  I GN ( Object : i n  Some_Type)do 
The  Object  :=  Object; 
end  ASSIGN; 

OR 

accept  RETRIEVE(Object:out  Some_type)do 
Object  :=  The  Object; 
end  RETRIEVE;  " 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

end  Special_Ops; 


vw! 


CALL  AND  WAIT  FOREVER 

To  CALL  AN  ENTRY,  SPECIFY  THE 
TASK  NAME  AND  THEN  THE  ENTRY  NAME 


BEGIN 


Tl.ENTRYKDATA); 


TIMED  ENTRY  CALL 

(wait  for  a  finite  tine) 

SELECT 

Tl.ENTRYl(DATA); 

<sos> 

OR 

DELAY  60 J 

<sos> 

END  SELECT; 


YOU  CANNOT  USE  AN  'OR'  TO  CALL  TWO  (or  more) 
TASK  ENTRIES!!! 

This  would  be  equivalent  to  standing  in  two 
different  lines  at  once* 


CONDITIONAL  ENTRY  CALLS 

(don't  wait  at  all) 


SELECT 

T1 .ENTRY] (DATA); 
<S0S> 

ELSE 

<so$> 

END  SELECT; 


Notice  the  'orthogonality'  or  the 
SELECT  statement.  It  is  used  in 
either  a  task  entry  call  or  an 
accept  statement. 


Also  notice  that  instead  cf 

' ACCEPT- .. BEG  in. •• END  ACCEPT; 
IT  IS 

.  'ACCEPT... 


do*  * . • end  ENTRY_NAME; 


TASK  ATTRIBUTES 
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SYNCHRONIZATION  OF  DATA 


TASK  SYNC  IS 
ENTRY  UPDATE 
ENTRY  READ 
end  SYNC; 


DATA  :  in  DATA  TYPE); 
DATA  : out  DATATYPE); 


TASK  BODY 

LOCAL  : 

BEGIN 

LOOP 


SYNC  is 
DATATYPE; 


in  DATA  TYPE)  do 


select 

accept  UPDATE ( DAT  A 
LOCAL  :=  DATA; 
end  UPDATE; 

OR 

TERMINATE; 

END  SELECT; 


SELECT 

accept  READ  (DATA  :  out  DAT A_TYPE )  do 
DATA  :=  LOCAL; 
end  READ; 
or 

terminate; 
end  select; 


END  LOOP; 
END  SYNC ; 


- 


FAMILIES  OF  ENTRIES 


type  URGENCY  is  (LOW,  MEDIUM,  HIGH); 
task  MESSAGE  is 

ENTRY  RECEI VE(URGENCY)  (DATA  :  DATATYPE); 
end  MESSAGE; 

task  body  MESSAGE  is 
begin 

LOOP 

SELECT 

accept  RECEIVE(HIGH)  (DATA: DATATYPE)  do 
end  RECEIVE; 

OR 

when  RECEIVE( HIGH) # count  =  0  => 

accept  RECEIVE(MEDIUM)  (DATA: DATATYPE)  do 

end  RECEIVE; 

OR 

WHEN  RECEIVE(HIGH) 'count+RECEIVE (MEDIUM ) 'count=0  => 
accept  RECE I VE ( LOW )  (DATA:  DATATYPE)  do 

end  *  RECEI VE; 

OR 

DELAY  1.0;  --  SHORT  WAIT 
END  MESSAGE; 


Same  thing,  with  no  guards 
type  URGENCY  IS  (LOW,  MEDIUM,  HIGH); 
task  MESSAGE  is 

entry  RECE IVE(URGENCY)  (DATA  :  DATATYPE); 
end  MESSAGE; 


task  body  MESSAGE  is 

BEGIN 

LOOP 

SELECT 

accept  RECEIVE(HIGH)  (DATA:  DATATYPE)  do 
end  RECEIVE; 

ELSE 

SELaccept  RECEIVE(MEDIUM)  (DATA:  DATATYPE)  do 


end  RECEIVE; 

ELSE 

SELECT 

accept  RECE1  VE(LOW)  (DATA:  DATATYPE)'  do 


OR 


end  RECEIVE; 


DELAY  1.0;  " 
END  SELECT; 

END  SELECT; 

END  SELECT; 

end  MESSAGE; 


SHORT  WAIT 
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REPRESENTATION  SPECIFICATIONS 


Length  Clause 


T ' STORAGE _ S 1 2E 

TASK  TYPE  T1  IS 
ENTRY  ENTRY  1; 
for  Tl'STORfiGE.SIZE  use 

2000 ‘SYSTEM.  ST0RA6E_IINI  T  ); 

end  Tl; 

The  prefix  T  denotes  a  task  type. 

The  simple  expression  may  be  static,  and  is  used 

TO  SPECIFY  THE  NUMBER  OS  STORAGE  UNITS  TO  BE 
RESERVED  OR  FOR  EACH  ACTIVATION  ( NOT  THE  CODE)  OF 
THE  TASK. 
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Address  Clause 


TASK  TYPE  T1  IS 

entry  ENTRY_1; 

FOR  T1  USE  AT  16#167A#; 

END  T 1 ; 

In  this  case,  the  address  specifies  the  actual 

LOCATION  IN  MEMORY  WHERE  THE  MACHINE  CODE 
ASSOCIATED  WITH  T1  WILL  BE  PLACED* 


TASK  T1  IS 

entry  ENTR Y_1 ; 
for  ENTR Y_1  use  at  16 #A0#; 
end  Tl; 


If  this  case,  ENTR Y_1  will  be  mapped  to  hardware 
interrupt  6A* 

Only  in  parameters  can  be  associated  with 
interrupt  entries* 

An  interrupt  will  act  as  an  entry  call  issued  by 
the  hardware,  with  a  priority  higher  than  any 
user-defined  task. 

Depending  upon  the  implementation,  there  can  be 
many  restrictions  upon  the  type  of  call  to  the 
interrupt,  and  upon  the  terminate  alternatives* 


NOTE:  YOU  can  directly  call  an  interrupt  entry. 


TASKS  AT  DIFFERENT  PRIORITIES 


Given  5  tasks,  3  of  varying  priority,  1  to  be  interrupt 

DRIVEN,  AND  1  THAT  WILL  BE  TIED  TO  THE  CLOCK. 

procedure  HEAVY_STUFF  is 
TASK  H I GH_PR I  OR  I T Y  is 

PRAGMA  PRIORITY(50);  "-OR  AS  HIGH  AS  SYSTEM  ALLOWS 
ENTRY  POINT; 

END  H 1 6 H _ P RIORITY; 

TASK  MEDIUM_PRI ORITY  is 
PRAGMA  PR10RITY(25); 

ENTRY  POINT; 

END  MED  I UM_PR I  OR  1 TY ; 

task  L0W_PRI0RITY  is 

PRAGMA  PRIORITY(l); 

ENTRY  POINT; 

END  LO W__P R I  OR  I  TY; 

TASK  INTERRUPT  DRIVEN  is 
ENTRY  POITTT; 

FOR  POINT  USE  AT  16#61#;  --INTERRUPT  97 
END  INTERRUPT_DRI VEN; 

task  CL0CK_DR I VEN  is 

--THERE  ARE  TWO  WAYS  TO  DO  THIS 

--First  way  is  to  have  another  task  monitor 
--  the  clock,  and  call  CL0CK_DR I VEN . CALL 

—  EVERY  TIME  UNIT. 

ENTRY  CALL; 

--Second  way  is  to  actually  tie  CALL  to  an 

--  CLOCK  INTERRUPT,  AND  LET  CALL  DETERMINE  WHEN 
--  HE  WISHES  TO  PERFORM  AN  ACTION 

for  CALL  use  at  1 6# 32# ;  --assume  interrupt  50 

--  IS  A  CLOCK  INTERRUPT 

END  CLOCK  DRIVEN; 

END  HEAVY_STUFF; 
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task  QUEUE  is 

ENTRY  INSERT ( DATA  :  in  DATA  TYPE); 

ENTRY  REMOVE ( DATA  :out  DATA  TYPE); 
end  QUEUE; 

TASK  BODY  QUEUE  IS 

HEAD, TAIL  :  INTEGER  :  =  0; 

Q  :  array  (1..100)  of  DATA_TYPE; 

BEGIN 

LOOP 

SELECT 

when  TAIL  -  HEAD  +  1  /=  0  and  then 
TAIL  -  HEAD  +  1  /-  100  => 
accept  I NSERT ( DAT  A  :  in  DAT  A_T  YPE )  do 
if  HEAD  =  0  then  HEAD  :=  1;  end  if; 
if  TAIL  =  100  then  TAIL  :  =  0;  f.nd  if; 
TAIL  :=  TAIL  +  1; 

Q( TAIL)  :•  DATA; 
end  INSERT; 
or 

when  HEAD  /=  0  => 

accept  REMOVE ( DATA  :out  DATATYPE)  do 
DATA  :=  Q( HEAD); 
if  HEAD  -  TAIL  THEN 
HEAD  :=  0; 

TAIL  :=  0; 

ELSE 

HEAD  :=  HEAD  +  1; 

IF  HEAD  >  100  then  HEAD  :=  1;  end  IF; 

END  IF; 

END  REMOVE ; 

OR 

TERMINATE; 

END  SELECT; 

END  LOOP; 

END  QUEUE; 
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TASK  TYPE  QUEUE  IS 

ENTRY  INSERT ( DATA  :  in  DATATYPE); 

entry  REMOVE (DATA  :out  DATA _ TYPE ) ; 

end  QUEUE; 

TASK  BODY  QUEUE  IS 

HEAD, TAIL  :  INTEGER  :=  0; 

Q  :  array  ( 1  * • 100 )  of  DATA_TYPE; 
begin 
loop 

SELECT 

when  TAIL  -  HEAD  +  1  /=  0  and  then 
TAIL  -  HEAD  +  1  /=  100  «> 
accept  INSERT ( DATA  :  in  DAT A_TYPE )  do 
IF  HEAD  *  0  then  HEAD  :=  1;  end  if; 
if  TAIL  *  100  then  TAIL  :*  0;  end  if; 
TAIL  TAIL  ♦  1; 

Q( TAIL )  :*  DATA; 
end  INSERT; 

OR 

when  HEAD  /=  0  => 

accept  REMOVE  ( DAT  A  :oijt  DAT  A_T  YPE )  do 
DATA  :=  Q( HEAD); 
if  HEAD  =  TAIL  then 
HEAD  :=  0; 

TAIL  0; 

ELSE 

HEAD  :«  HEAD  +  1; 

if  HEAD  >  100  then  HEAD  :=  1;  end  if; 
end  if; 
end  REMOVE; 
or 

terminate; 

END  SELECT; 

END  LOOP; 

END  QUEUE; 

MY_QUEUE,  YOU R_0UEU E  :  QUEUE;  —  two  tasks 


•- -  ■  .*•  .>  .*>  .■vJKv-n >v>> 


GENERIC 

DATA  TYPE  :  private; 
QUEUF_SI ZE :  POSITIVE 

package  QUEUE_PACK  is 


100; 


task  QUEUE  is 

ENTRY  INSERT ( DATA  :  in  DATATYPE); 

ENTRY  REMOVE < DATA  :out  DATATYPE); 
end  QUEUE; 

package  body  QUEUE_PACK  is 
TASK  BODY  QUEUE  IS 

HEAD, TAIL  :  INTEGER  :=  0; 

Q  :  array  ( 1  •  •  QUEUE_S I  ZE )  of  DATATYPE; 

BEGIN 

LOOP 

SELECT 

when  TAIL  -  HEAD  +  1  /=  0  and  then 
TAIL  -  HEAD  +  1  /=  QUEUE  SIZE  ■> 
accept  INSERT ( DAT  A  ;  in  DAT  A_TYPE )  do 
if  HEAD  =  0  then  HEAD  :=  1;  end  if; 
if  TAIL  =  QUEUE  SIZE  then  TAIL  :=  0;  end  if; 
TAIL  :=  TAIL  +  T; 

Q(TAIL)  :=  DATA; 
end  INSERT; 

OR 

when  HEAD  /=  0  => 

accept  REMOVE(DATA  :out  DATATYPE)  do 
DATA  :=  Q( HEAD); 
if  HEAD  =  TAIL  then 
HEAD  :=  0; 

TAIL  :=  0; 

ELSE 

HEAD  :=  HEAD  +  1; 

if  HEAD>  QUEUE_SIZE  then  HEAD  :=  1;  end  if 
end  if; 
end  REMOVE; 

OR 

terminate; 

END  SELECT; 

END  LOOP; 

END  QUEUE; 


package  NEW_QUEUE  is  new  QUEUE_PACK(MY  RECORD,  250); 
package  OLD  QUEUE  is  new  QUEUE_PACK( INTEGER); 


procedure  INSERT  INTEGER  (DATA  :  in  INTE6ER  )  renames 
OtD.QUEUE. INSERT; 

procedure  REMOVE _ I NTEGER  (DATA  :out  INTEGER  )  renames 

OLD_QUEUE • REMOVE ; 


procedure  SPIN  (R  :  RESOURCE) 

BEGIN 

LOOP 

SELECT 

R. SEIZE; 

return; 

ELSE 

NULL;  "BUSY  WAITING 
END  SELECT; 

END  LOOP; 

end; 


■0R~ 


procedure  SPIN  (R  :  RESOURCE) 

BEGIN 

R. SEIZE; 
return; 
end; 


McD 


CONSUME<MY_TRRY>; 
end  loop; 
end  GONZO; 
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end  GONZO; 


v*. 


0 

T3 


Ul 

CL 

> 

H 

I 

G 

O 

o 

Ll 


3 


t  II 

LL  " 

D  Ll 
a:  o  .» 

LL  I  LL 

in  >  :> 


> 

a: 

£ 

H 
i  o 

3  Qi 

LL  1! 
Z  Ul 


■tfosui 

Sl-U1 

a  T3 
u  c 
10  01 


null; 

end  select 


LU 

E 

3 

Ul 


a 

u 


p 

0 

Qi 

lit 


Z 

LU 

o 

a 

o 

I 

> 

E 

v 

LU 

Z> 

Z 

u 

in 

■ 

a 

o 

E 


3 

in 

z 

o 

o 


L 

a 


■*> 


Z 

lu 

U"t 

LU 

Q 

h* 

i/t 

Z 

3 

lu 

o 

Z 

H 

3 

1 

> 

E 

Z 

E 

V 

1 

E 

LU 

S 

# 

D 

Z 

tn 

■  »> 

P 

3 

LU 

3t  .. 

0 

• 

in 

ie  p 

in 

P  ^ 

"3  x 

»  M 

3t 

fQ 

ai 

3  Qi 

*  s 

3  — 

a 

a 

L 

e  s 

3 

in 

0 

Q)  lit 

T3 

c 

Qi 


nd  loop; 


Q 


A 

ft 

svt 

lu 

Q 

a 

a 

i 

> 

IY_ORDER) 

•0* 

A 

ft 

LU 

• 

E 

V 

a 

ft 

LU 

£ 

V 

a 

i 

3 

LU 

a: 

Z>  .. 

> 

LU 

a  ** 

E 

in 

• 

a 

LU  U 
1/1  ® 

LU 

E 

o 

x  ai 

3 

0  E 
Qi 

CD 

"0 

LO 

Z 

■  0> 

a 

0 

0 

L  C 

a 

0 

HI 

0  Qi 

u 

p- 

"C 

C 

Scenario  II 


k  Body  McD  is 

CASH.DRAWER,  AMOUNT. PAID*  MONEY.TYPE; 
NEM.ORDER  :  FOOD.TYPE; 
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Task  BR  is 

entry  SERUE<ICE_CREflM=  out  DESSERT_TYPE» 
end  BR; 
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Package  PRINTER_PflCKflGE  is 


end  PRINTER_PflCKflGE; 
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end  loop; 
end  SPOOLER: 
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Solution  4  -  write  buffer 


IN-CLASS  EXERCISE 


Let  us  design  the  task  specifications  for  the  following 
SEN AR I O • 


Three  tasks  have  acces  to  a  type  known  as  MESS AGE_T YPE • 

TASK_1  PRODUCES  MESSAGES*  TASK_2  CAN  RECEIVE  MESSAGES, 
HOLD  them  in  a  buffer  (if  necessary),  and  sends  them  TO 
TASK_3  when  the  date/time  field  (part  of  ME$SAGE_TYPE) 
says  to* 


task  TASK_1  is 


end  TASK_1; 


task  TASK_2  is 


end  TASK_2; 


task  TASK  3  is 


end  TASK_3; 
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Tasking  Exercise 


'■  Write  a  main  program  and  two  tasks  to  simulate  a  house  alarm 

system.  The  main  program  is  an  input  simulator  to  the 
tasks.  One  task  keeps  track  of  the  status  of  the  house, 
a  Another  is  the  actual  alarm  system. 


Task  1:  The  House  Status  (Task  Name  : HOU SE ) 

Three  Entries  ■>  OK,  N0T_0K,  WRITE 

The  entries  OK  and  N0T_0K  set  or  reset  a  flag  that 
determines  the  status  of  the  house.  N0T_0K  will  also  set  a 
variable  to  tell  you  which  alarm  is  currently  going  off. 
Both  OK  and  N0T_0K  should  print  out  a  message  verifying  that 
they  were  called.  The  WRITE  entry  will  print  the  status  of 
the  house.  If  there  is  an  alarm  currently  going  off,  WRITE 

WILL  TELL  YOU  THE  ALARM  NUMBER. 

« 


i  m 

y 


Task  2:  The  Alarm  System  (Task  name:  ALARM)  . 

Three  Entries  =>  FIRE,  INTRUDER,  SHUTOFF 

The  Alarm  System  will  accept  any  of  the  three  entry 

CALLS  FROM  THE  INPUT  SIMULATOR.  If  THERE  ARE  NO  ENTRY  CALLS 
WITHIN  5  SECONDS,  IT  WILL  CALL  HOUSE . WR I TE  TO  DISPLAY  THE 
STATUS.  FIRE  AND  INTRUDER  EACH  have  a  parameter  indication 

THE  ALARM  LOCATION-  FIRE  LOCATIONS  ARE  '1'  THRU  '9'. 

INTRUDER  locations  are  'A'  thru  'Z'.  FIRE  and  INTRUDER 
should  call  HOUSE. NOT_OK  (and  tell  the  house  where  the  alarm 
is  sounding),  and  then  print  out  a  message 


Main  Program 


l 


The  main  program  will  read  in  characters  from  the 
keyboard-  If  the  character  is  a  '1'  thru  '9',  call  the  fire 
alarm.  If  the  character  is  a  'A'  thru  1 V  then  it  calls  the 

INTRUDER  ALARM.  If  THE  CHARACTER  IS  A  'O'(ZERO),  THE  HOUSE 
IS  RESET  TO  OK.  IF  THE  CHARACTER  IS  A  '!',  THEN  THE  ALARM 
IS  SHUTDOWN,  AND  THE  PROGRAM  ENDS*  ALL  OTHER  CHARACTERS  DO 
NOTHING* 


K’ 
r  : 

*■: 


f 

* 

f 


The  house  status  should  be  OK  to  start. 
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cun  cookie 

The  house  is  ok 

The  house  is  ok 

fc 

Invalid  character.  Try  again 

The  house  is  ok 
G 

House  alarm  set  to  not  OK  at  location  G 
Intruder  in  room  G 

The  house  is  not  ok  ..alarm  is  off  at  location  G 

The  house  is  not  ok  ..alarm  is  off  at  location  G 

4 

House  alarm  set  to  not  OK  at  location  4 
Fire  Alarm  #  4  has  been  set  off. 

The  house  is  not  ok  ..alarm  is  off  at  location  4 

0 

House  alarm  reset  to  OK. 

The  house  is  ok 

The  house  is  ok 

! 

The  alarm  has  been  turned  off 

•> 


\ 


V.V 


ft' 


: 


■M 


PROCEDURE  COOKIE  IS 

CHAR  :  CHARACTER; 

TASK  HOUSE  IS 
ENTRY  OKj 

entry  NOT  OK  (WHERE:CHARACTER); 
ENTRY  WRITE; 

END  HOUSE  ; 

task  ALARM  is 

entry  FIRE  (LOCATION rCHARACTER) 
ENTRY  INTRUDER  (LOCATION iCHARACTER) 
entry  SHUTOFF; 
end  ALARM  ; 


•  - 


Xvv. 
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TASK  BODY  HOUSE  IS 

TYPE  CONDITION  is  (OK,  NOT  OK); 
ALARM.STATUS  :  CONDITION  :«  OK; 
ALARM_LOCATION  !  CHARACTER; 


BEG  IN 

LOOP 


SELECT 

ACCEPT  OK  DO 

ALARM  STATUS  :«  OK; 

PUT_LlNE( 'House  alarm  reset  to  OK.'); 
end  OK; 

OR 

accept  NOT  OK  (WHERE:CHARACTER)  do 
ALARMJTTATUS  NOT  OK; 

ALARM  LOCATION  WHERE; 
put_LINE('House  alarm  set  to  not  OK  at'& 


LOCATION 

end  NOT_OK; 


&  ALARM_L0CATI0N); 


ACCEPT  WRITE  DO 
NEW.LINE; 

case  ALARM_STATUS  is 
when  OK  *=>PUT  LI NE ( "The  house  is  oi 
wMen  N0T_0K  ->  PUT_LINE 

('The  house  is  not  ok'& 

'  ..ALARM  IS  OFF  AT  LOCATION 

ALARMJ.0CATI0N); 

END  CASE; 

NEW  LINE; 
end  WRITE; 


ok'  ); 


TERMINATE; 
END  SELECT; 

END  LOOP; 

END  HOUSE  ; 
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TASK  BODY  ALARM  IS 
BEGIN 

LOOP 

SELECT 

accept  FIRE  (LOCATION: CHARACTER)  do 
HOUSE. N0T_0K( LOCATION); 

PUT  ('Fire  Alarm  #  "); 

PUT  (LOCATION); 

PUT  ClNE  (*  has  been  set  OFF.'); 

END  FIRF; 

OR 

ACCEPT  INTRUDER  ( LOCAT I  ON : CH AR ACTER )  do 
HOUSE. NOT_OK(LOCATION); 

PUT  ("Intruder  in  room  *); 

PUT  (LOCATION); 

NEW  LINE; 
end  INTRUDER; 

OR 

accept  SHUTOFF; 

PUT_LINE  ("The  alarm  has  been  turned  off*) 
exit; 
or 

delay  5*0; 

HOUSE. WRITE; 

END  SELECT; 

END  loop; 

END  ALARM; 


-MAIN 


BEGIN 


LOOP 

GET  (CHAR); 
SKIPJ.INE; 
case  CHAR  is 

when  '1'  -  ' 

WHEN  'A'  ••  ' 
WHEN  'A'  •  • 
WHEN  'O' 

WHEN  '!' 

WHEN  OTHERS 

(*I 


9'  ->  ALARM. FIRE  (CHAR); 
z'  •>  ALARM. INTRUDER  (CHAR); 

V  ->  ALARM. INTRUDER  (CHAR); 

«>  HOUSE. OK; 

">  ALARM. SHUTOFF; 

->  PUTJJNE 

NVALID  CHARACTER.  TRY  AGAIN*); 


END  CASE; 

EXIT  WHEN  CHAR 
END  LOOP; 


Towers  of  Hanoi 

An  example  of  recursion 


recursion:  n ,  see  recursion. 


Problem:  Move  disks  from  one  tower  to 
another  tower. 

Constraints: 

Move  only  1  disk  at  a  time. 

Place  no  disk  on  a  smaller  disk. 


Top  down  design  approach: 

Assume  a  procedure  to  move  N  disks: 
type  Towers  is  (Middle,  Left,  Right); 
procedure  Move  (N  :  in  positive; 

From, 

To, 

Other  :  in  Towers); 


Use  the  procedure  and  solve  the  problem 
Move  (N=>3,  From  =>  Middle, 

To  =>  Left, 

Other  =>  Right); 


Using  this  approach,  we  can  now  create  a 
complete  Ada  program: 
procedure  Towers_ofJHanoi  is 
type  Towers  is  (Middle,  Left,  Right); 
procedure  Move  (N  :  in  positive; 

From, 

To, 

Other  :  in  Towers) 

is  separate; 
begin 

Move(3,  From  =>  Middle, 

To  =>  Left, 

Other  =>  Right); 
end  Towers_of_Hanoi; 


Implement  the  procedure  in  pseudocode: 
separate  (Towers_of_Hanoi) 
procedure  Move  (N  :  in  positive; 

From, 

To, 

Other  :  in  Towers) 
is 

begin 

null; 

—  if  more  than  one  disk  to  move, 

—  Move(N-1 ,  from  => _ , 

to  => _ , 

other  => _ ); 


—  move  the  only  disk  left  on  ’from'  to  ’to 


—  if  more  than  one  disk  to  move, 

—  Move(N-l ,  from  => _ , 

to  => _ , 

other  => _ ); 

end  Move; 


■>  ->  .'o  v  v  v  vvvv  v  v  v  v  yvv 


Now  rewrite  the  procedure  in  Ada: 
with  TextJO; 

separate  (Towers_of_Hanoi) 
procedure  Move  (N  :  in  positive; 

From, 

To, 

Other  :  in  Towers) 
is 

begin 

if  N  >  1  then 

Move(N-1,  From  =>  From, 

To  =>  Other, 

Other  =>  To); 

end  if; 

TextJO.putJineC'Move  disk  from  " 

6k  Towers'lmage(From) 
&  "  tower  to  " 

6k  Towers'lmage(To) 

6k  "  tower."); 

if  N  >  1  then 

Move(N-1 ,  From  =>  Other, 

To  =>  To, 

Other  =>  From); 

end  if; 


end  Move; 


Sieve  cl  Eraiosiibmes 


Eratosthanes,  of  Alexandria,  was  a  Greek  mathematician  He 
developed  an  elegant  algorithm  for  generating  prime  numbers 

1.  2  is  the  first  prime  number  , 

2.  for  each  positive  number,  N,  greater  than  2,  if  it  is  not 
divisible  by  any  prime  less  then  N,  it  is  prime. 

This  algorithm  has  a  natural  implementation  in  Ada 


Imagine  that  a  separate  process  is  available  for  each  prime 
number,  that  can  check  the  "relative"  primeness  of  a  number. 


We  can  now  "pipeline"  these  processes  with  all  the  positive 
numbers,  any  number  that  makes  it  through  the  "pipe"  is  prime! 


Create  a  task  which  feeds  numbers  into  the  pipe: 
task  Feeder, 

Create  a  task  template  which  accepts  a  value  and  checks  it  for 
primeness : 

task  type  Checker  is 
entry  CheckJt  (In_Value  :  Positive), 
end  Checker, 


But,  this  checker  task  needs  to  know  what  prime  number  it 
uses  Often  we  find  the  case  in  Ada  tasks  where  the  task  must  be 
initialized  with  information 

task  type  Checker  is 

entry  Who_Am_I  (In_Vaiue  :  Positive); 
entry  Check_It  (In.Value  :  Positive); 
end  Checker, 


Finally,  we  need  to  create  new  tasks  when  we  find  that  a 
number  is  prime  : 

procedure  Make_New_Checker 

(A_Prime_Number :  in  Positive, 

New_Checker  :  out  Checker _Ptr), 

We  can  create  an  operation  to  construct  a  task  only  by  using  a 
pointer  to  the  new  task. 


Sieve  -  2 


There  are  many  ways  to  link  the  checker  tasks  together  ink: 

the  “pipe"  This  linking  determines  and  is  determined  by  the 
manner  used  to  pass  the  numbers  being  checked  from  task  to 
task 

I  chose  to  have  each  task  contain  the  name  of  the  next  task 
the  pipe 


Sieve  -  3 


procedure  Primes  is 
task  Feeder, 


type  Checker; 

type  Checker _ptr  is  access  Checker, 
task  type  Checker  is 
entry  Who_Am_I  (In.Value  :  Positive); 
entry  Check_It.  (In_Value  :  Positive); 
end  Checker, 


procedure  Make_New_Checker  (A_Prime_Number  :  in  Positive; 

New_Checker  :  out  Checker _Ptr), 

Front :  Checker_ptr;  —  This  is  the  front  of  the  "pipe”. 

task  body  Feeder  is  separate, 

task  body  Checker  is  separate; 


procedure  Make_New_Checker  (A_Prime_N umber  :  in  Positive, 

New_Checker  :  out  Checker _Ptr) 


is  separate; 


begin 

null, 

end  Primes, 


with  Text_IO,  Integer- 10, 
separate  (Primes) 

procedure  Make_New_Checker  (A _Prime_Number  :  in  Positive, 

New_Checker  :  out  Checker  _Ptr)  is 

Result :  Checker _Ptr; 

begin 

-  We  have  been  given  a  prime  number,  display  it: 

Integer  JO.Put  (A_Prime_Number); 

-  Make  a  new  prime  *  task  for  it: 

Result  :=  new  Checker; 

Result. Who_Am_I  (A_Prime_Number);  -  Tell  the  task  it’s  prime  m. 

-  Allow  the  task  to  be  used  in  the  “pipe". 

New_Checker  :*  Result; 

exception 

when  Storage_Error  => 

TexL_I0. Put_Line  ("  Not  enough  room  to  make  new  tasks  "), 
end  Make_New_Checker; 


with  TexL.10,  Integer_IO, 
separate  (Primes) 
task  body  Feeder  is 
Upper_Limit :  Positive; 

begin 

Text_IO.Put  ("Upper  limit  for  primes?  ”); 
Integer_IO.Get  (Upper-Limit), 

--  Generate  the  first  prime  *: 
Make_New_Checker  (2,  Front); 


--  Feed  the  "pipe". 

for  Counter  in  3  Upper-Limit  loop 
Front.Check_It  (Counter), 

end  loop. 


end  Feeder, 


Sieve  -  5 


separate  (Primes) 
task,  body  Checker  is 
My.Value, 

Value_to_Check :  Positive, 

Next-Checker  :  Checker_Ptr, 

Prime  :  Boolean; 

begin 

accept  Who_Am_I  (In.Value  :  Positive)  do 
My_Value  :=  In_Value; 
end  Who_Am_I; 

loop 

select 

accept  Check_It  (In_Value  :  Positive)  do 
Value_to_Check :« In_Value; 
end  Check_It; 
or 

terminate, 
end  select. 

Prime  :=  (Value_to_Check  /  My_Value)  *  My.Value  /=  Value_to_Check; 
if  Prime  then 

if  Next-Checker  /=  null  then 

--  It’s  not  divisible  by  my  number,  pass  the  value  on 
Next-Checker  ,Check_I  t  ( Valu.e_to_Check ); 


--It  really  is  prime. 

Make_New_Checker  (Value^to_Check,  Next-Checker), 

end  if, 

end  if, 
end  loop; 

end  Checker, 


Sieve  -  6 


The  Dining  Philosophers 

The  scenario:  Five  philosophers  sit  at  a  table. 

A  lazy  Susan  containing  dishes  of  Chinese  food  is  in 
the  center  of  the  table.  Each  philosopher  has  a 
plate,  but  there  are  only  five  single  chopsticks,  one 
between  each  philosopher. 

The  problem:  Develop  a  program  that  allows 
each  philosopher  to  alternately  eat  and  think 
forever.  Of  course,  no  philosopher  should  preclude 
any  other  from  eating  for  an  indefinite  amount  of 
time. 

The  constraints:  Each  philosopher  must  have 
control  of  two  chopsticks  to  eat.  But,  he  can  only 
use  those  that  were  originally  on  either  side  of  his 
plate. 


Socrates 


<2> 

Platt 


Aristotle 


Q> 

Einstein 


<2> 

Buddha 


1  This  problem  was  first  stated  by  Edsgar  Dijkstra  as  a  challenge  to  the 
mult  it  ask  ing  community 


Approach: 

Each  philosopher  can  wait  in  a  queue  for  his 
chopsticks.  If  at  least  one  philosopher  is  eating,  we 
will  not  have  deadlock.  If  philosophers  are  not 
blocked  from  entering  a  queue,  then  we  will  not  have 
indefinite  postponement. 

Model  the  chopsticks  as  counting 
semaphores. 

Do  not  make  all  the  philosophers 
right-handed  or  left-handed. 


Object  Oriented  Design: 

Object  -  Chopstick 
Operations  -  Pick_Up,  Put_Down 

Object  -  Philosopher 
Operations  -  Give_Names 

Object  -  Console 
Operations  -  Display 


with  Wrap_Around, 
procedure  Diners  is 

type  Names  is  (Socrates,  Plato,  Buddha,  Einstein,  Aristotle), 

task  type  Chopstick  is 
entry  PickjJp, 
entry  Put_Down, 
end  Chopstick, 

task  type  Philosopher  is 
entry  Giyejvlames  (Myjvlame,  First_Stick, 

Second_Stick  :  in  Names), 

end  Philosopher, 

--  Each  chopstick  carries  the  name  of  the  philosopher  to 
--  its  right. 

Chopsticks  :  array  (Names)  of  Chopstick, 

Philosophers  :  array  (Names)  of  Philosopher, 

task  Console  is 

entry  Display  (Message  :  in  String); 
end  Console, 

task  body  Console  is  separate, 
task  body  Chopstick  is  separate, 
task  body  Philosopher  is  separate, 

function  Wrap  is  new  Wrap_Around  (Names), 

begin 

-Tell  each  philosopher  his  name. 

Philosophers  (Names'First).Give_Names 

( My_Name  =>  Names'First, 

First_Stick  ->  Wrap(Names'First), 
$econd_Stick  =>  Names'First ), 

for  Loopjndex  in  Wrap  (Names'First)  ..  Names’Last 
loop 

Philosophers  (Loopjndex)  GiYe_Names 

( My_Name  *>  Loopjndex, 

First_Stick  ->  Loopjndex, 

$econd_$tick  ->  Wrap(LoopJndex) ), 

end  loop, 
end  Diners, 


with  Text  10, 
separate  "(Diners) 
task  body  Chopstick  is 
begin 
loop 
select 

accept  PickJJp,  --Callers  will  be  queued  here, 
accept  Put_Down,  --Resource  is  released  here 
or 

terminate,  --  Server  task  offers  to  quit, 

end  select, 
end  loop, 


exception 
when  others  => 

Text_IO.Put_Line  ("Chopstick  task  died"), 


end  Chopstick, 
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yV  it  it  T  ext_!  O, 
separate  (Diners) 
task  body  Philosopher  is 
My_Name, 

First_Stick, 

Second_Stick  :  Names; 
begin 

accept  GiYe_Names(My_Name, 

First_$tick, 

$econd_$tick  :  in  Names)  do 
Philosopher.My_Name  >  My_Name, 

Philosopher.First_Stick  >  First_Stick, 

Philosopher.Second_Stick :«  Second_$tick, 
end  Give_Names; 

declare 

Eating_Message  :  constant  String 

Names,lmage(My_Name)  &  "  eating" 

Thinking_Message  :  constant  String  := 

Names'lmage(My_Name)  &  "  thinking 

begin 

loop 

Chopsticks  (First_$tick).Pick_Up, 

Chopsticks  (Second_Stick).Pick_Up, 

Console.Display(Eating_Message), 

Chopsticks  (First_Stick).Put_Down, 

Chopsticks  (Second_Stick).Put_Down, 

Console  Display  (Thinking_Message), 

end  loop, 
end, 

exception 
when  others  -> 

TextJO.Put_Line  ("Philosopher task  died"), 


end  Philosopher, 


with  Text  JO, 
separate  (Diners) 
task  body  Console  is 
begin 
loop 
select 

accept  Display  (Message  .  in  String)  do 
TextJO.Putj.ine  (Message), 
end  Display, 
or 

terminate,  --  Server  task  offers  to  quit 
end  select, 
end  loop, 


exception 
when  others  *> 

TextJO.PutJ.ine  ("Console  task  died  "), 
end  Console, 
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GENERICS 


□  Why  program  at  all? 

□  Why  program  generically? 

□  What  does  generics  provide? 

□  How  do  you  write  a  generic  unit? 

□  Parameterless  Generics 

□  Parameterized  Generics 

□  Value  and  Object  Parameters 

□  Type  Parameters 

□  Subprogram  Parameters 

□  What  are  the  Cons  of  generics? 

□  What  are  the  Pros  of  generics? 

□  What  are  the  unresolved  issues? 


□  How  do  you  teach  generics? 


Why  program  at  all? 

□  Reusability  -  a  programmed  solution 
can  be  used  over  and  over 

□  Reliability  -  program  can  be  tested  and 
verified  to  ensure  correct  results  for 
subsequent  runs 

□  Readability  -  program  formalizes  human 
solution  and  represents  it  in  more 
abstract  readable  form 

□  Maintainability  -  making  a  change  to 
a  program  ensures  that  the  change  is 
consistently  applied  to  all  problem 
solutions 


/‘v'^Vv'v'v  w  V  VV/  Ww-Wj1  ", 


Why  program  generically? 


□  Reusability  -  similar  program  units 
needed  but  different  enough  to 
preclude  simply  entering  differing 
values  at  run  time 

□  Reliability  -  generic  unit  once  tested 
and  verified  does  not  need  to  be  retested 
for  each  new  use  or  "instantiation" 

□  Readability  -  using  generic  unit  allows 
extraction  of  the  "essence"  of  the  unit 
eliminating  application  specific  details 
and  produces  a  very  uncluttered  readable 
unit 

□  Maintainability  -  a  change  made  to  the 
unit  applies  to  all  uses  of  the  unit 


Traditional  Programming 


Algorithms,  Objects,  Resources 
—  intermixed  with  — 
Problem  specifics 


The  Price  of  Strong  Typing 
An  Example 

procedure  Swap(X,Y :  in  out  INTEGER 
Temp :  INTEGER  ; 
begin 
Temp  :=  X; 

X  :=  Y; 

Y  :=  Temp; 
end  Swap; 

procedure  Swap(X,Y  :  in  out  CHARACTER 
Temp :  CHARACTER ; 
begin 
Temp  :=  X; 

X  :=  Y; 

Y  :=  Temp; 
end  Swap; 

procedure  Swap(X,Y  :  in  out  FLOAT 
Temp :  FLOAT  ; 
begin 
Temp  :=  X; 

X  :=  Y; 

Y  :=  Temp; 
end  Swap; 


type  GRADE  is  range  0 . .  1 00; 
procedure  Swap(X,Y  :  in  out  GRADE 
Temp :  GRADE  ; 
begin 
Temp  :=  X; 

X  :=  Y; 

Y  :=  Temp; 
end  Swap; 


Generic  Programming 


Algorithms,  Objects,  Resources 


separated  from 


Problem  specifics 


A  "generic"  Swap  Procedure 


generic 

type  ELEMENT  is  private; 
procedure  Swap(X,Y  ;  in  out  ELEMENT); 

procedure  Swap(X,Y  :  in  out  ELEMENT)  is 
Temp  :  ELEMENT; 
begin 
Temp  X; 

X:-  Y; 

Y  Temp; 
end  Swap; 

procedure  SwapThings  is 
X  :  integer  5; 

Y  ;  integer  10; 

Letter  1  :  character  A'; 

Letter2  ;  character  Z'; 

procedure  IntSwap  is  new  Swap(integer); 
procedure  CharacterSwap  is 

new  Swap  (ELEMENT- character); 


begin 

IntSwap(X.Y); 

CharacterSwap(Letter  1  ,Letter2); 
end  SwapThings; 


Syntax  and  Semantics 


generic 

. . .  formal  parameters  go  here  . . . 
subprogram  or  package  specification 

subprogram  or  package  body 
. . .  body  goes  here  . . . 


instantiation  to  create  a  usable  unit 
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What  does  generics  provide? 


□  Generics  serve  as  “templates'  for 
creating  or  “instantiating"  similar 

conceptual  “chunks' of  code  (packages,  functions,  or 
procedures) 

□  Generics  allow  removing  the  problem 
specifics  from  a  program  unit  adding 
greater  clarity  to  its  understandability 

□  Generics  allows  the  programmer  to  introduce  a 
level  of  abstraction  to  increase  program 
understandability 

□  Generics  reduce  user's  source  code 
size  thereby  making  it  more  readable 
and  maintainable 

□  Generics  enhance  REUSE  of  software 
components,  facilitating  modular 
system  development  and  easier 
verifiability 

□  Generics  provide  an  elegant  solution 
to  the  restrictions  imposed  by 
strong  typing 

0  Generics  provides  a  mechanism  for  passing 
subprograms  as  parameters 

□  Generics  provides  a  mechanism  for  doing  10 

(if  needed)  for  all  predefined  and  user -defined  types 
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Parameterless  Generics 
"Cloning"  Units 

A  nongeneric  '  unique  object"  Stack  package: 

package  Stack  is 
procedure  Pop(I :  out  integer); 
procedure  Push(I :  in  integer); 
function  Empty  return  boolean; 
function  Full  return  boolean; 
end  Stack; 

A  non-generic  “many  objects"  solution: 

package  Stacks  is 
type  Stack  is  . . .; 

procedure  Pop(S  :  in  out  Stack;  1 :  out  integer); 
procedure  Push(S  :  in  out  Stack;  1 :  in  integer); 
function  Empty(S  :  Stack)  return  boolean; 
function  Full(S  :  Stack)  return  boolean; 
end  Stacks; 

—  changes  must  be  made  to  body  of  package  also 

A  sample  user  program: 
procedure  StackUp  is 
SI,  S2  :  Stack;  Item  :  integer; 
begin 

Push(Sl.lO);  Push(S2,5);  Pop(Sl.Item); 
end; 


raw , 


.Miy 


Parameterless  Generics  cont. 

A  generic  "many  objects"  solution: 
generic 

package  Stack  is 
procedure  Pop(I :  out  integer); 
procedure  Push(I :  in  integer); 
function  Empty  return  boolean; 
function  Full  return  boolean; 
end  Stack; 

—  generic  body  is  identical  to  non-generic  one 

—  no  changes  have  to  be  made  to  get  many  stacks 

A  sample  user  program: 

with  Stack; 
procedure  StackUp  is 
Item  :  integer; 
package  SI  is  new  Stack; 
package  S2  is  new  Stack; 
begin 

Sl.Push(lO);  S2.Push(5); 

Sl.Pop(Item);  S2.Pop(Item); 
end  StackUp; 


Parameterless  Generics  cont. 


□  Stack  implementations  compared 

□  Non-generic  package  -  only  one 
elaboration  and  initialization  occur 

□  Generic  package  -  multiple 
elaborations  and  initializations  occur 
-  once  for  each  package 


Example:  with  Text_IO; 

package  body  Stack  is 
•  •  • 

begin 

Text_IO.Put("New  stack  created.  ”); 
end  Stack; 


package  SI  is  new  Stack;  —  message  prints 
package  S2  is  new  Stack;  —  message  prints  again 
pacakge  S3  is  new  Stack;  —  message  prints  again 


Parameterless  Generics 
"Cloning"  Things 


"Making  The  Mold" 
package  VDU  is 

subtype  Y_Range  is  integer  range  t  ..  24; 
subtype  X_Range  is  integer  range  1  . .  80; 
procedure  Write(S  :  in  string); 

—  writes  S  to  screen  at  current  cursor  loc 
procedure  Move(Y  :  in  Y_Range;  X  :  X_Range); 

—  changes  cursor  position  to  (X,Y) 

•  •  • 

end  VDU; 


generic 

package  VDU  is 

subtype  Y_Range  is  integer  range  1  . .  24; 
subtype  X_Range  is  integer  range  1  . .  80; 
procedure  Write(S  :  in  string); 

—  writes  S  to  screen  at  current  cursor  loc 
procedure  Move(Y  :  in  Y_Range;  X  :  X_Range); 

—  changes  cursor  position  to  (X,Y) 

■  •  • 

end  VDU; 


Generic  Instantiation 
"Cloning"  Things  Continued. . . 


Making  The  Copies 


package  VDU 1  is  new  VDU; 
package  VDU2  is  new  VDU; 


VDUl.WriteC'VDU  I");  VDU2.Write(“VDU  2’); 


**What  if  we  included  “Use  VDU1,  VDU2;"  ? 
Would  we  still  need  to  be  explicit  and  use  the 
package  name  and  dot  prefix  notation? 


I* VDU  eiample  taken  from  ADA  Language  and  Methodology  by  Watt, 
Wichmann,  and  Findlayl 


Creating  Library  Units 

of 

Generic  Instantiations 


—  compile  following  separately  into  the  library 
with  Stack; 

package  SI  is  new  Stack; 


—  SI  is  now  a  usable  library  unit 

with  SI;  use  SI; 
procedure  StackUp  is 
Item  :  integer; 
begin 
Push(10); 

Push(20); 

Pop(Item); 
end  StackUp; 


Parameterized  Generics 


□  Generic  Parameters 

□  Value  and  Object  Parameters 

□  Type  Parameters 

□  Subprogram  Parameters 


Value  and  Object  Parameters 

□  Value  Parameters 

□  Are  of  mode  IN 

□  Serve  as  local  constants  in 
generic  units 

□  Object  Parameters 

□  Are  of  mode  IN  OUT 

□  Serve  as  global  objects  in 
generic  units 


Value  Parameters 


generic 

Max :  in  integer; 

Min  :  integer;  —  default  mode  is  IN 
procedure  BigNSmall(X :  integer); 

procedure  BigNSmall(X  :  in  integer)  is 
begin 

if  X  >  Max  then 

Max  X;  —  not  with  mode  IN 
end  if; 

if  X  <  Min  then 

Min  X;  —  not  with  mode  IN 
end  if; 

end  BigNSmall; 


Value  Parameters 
and 

Initialization  Before  Instantiation 


□  Actual  parameters  which  are  to  match 
with  formal  generic  value  parameters 
must  have  been  initialized  before  the 
instantiation  occurs 

Example: 

generic 

Max :  in  integer; 

Min  :  integer;  —  default  mode  is  IN 
procedure  BigNSmall(X :  integer); 

procedure  UseBigNSmall  is 
LocalMin  :  integer;  —no  initial  value 
LocalMax  :  integer;  —  no  initial  value 
X :  integer  >100; 

procedure  Extremes  is  new 

BigNSmall(Max->LocalMax,Min->LocalMin); 
—  error  occurs  due  to  lack  of  initialization 


begin 

Extremes(X); 


end  UseBigNSmall; 


Value  Parameters 
and 

Levels  of  Abstraction 

generic 

Lower,  Upper  :  in  character; 
function  In_Range(S  :  in  string)  return  boolean; 

function  In_Range(S  :  in  string)  return  boolean  is 
begin 

for  I  in  S' Range  loop 
if  S(I)  not  in  Lower-Upper  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  In_Range; 

A  non-generic  version  of  In_Range: 

function  In_Range(S  ;  in  string;  Upper  .Lower  ; 

character)  return  boolean  is 
begin 

for  I  in  S'Range  loop 
if  S(l)  not  in  Lower  ..  Upper  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  In_Range; 


Value  Parameters 
and 

Levels  of  Abstraction  cont. 


□Compare  clarity  in  user’s  programs  using 
generics  to  add  another  level  of  abstraction 
in  ’’customized’’  names  for  In_Range  function 

with  In_Range; 
procedure  InBounds  is 
Name  :  string(  1  A)  :=  "JACK"; 

Phone  :  string(  1 .7)  :=  "6725643"; 
begin 

if  In-RangefName/A'/Z')  then . . . 
if  In_Range(Phone/079‘)  then  . . . 
end  InBounds; 


with  In_Range; 
procedure  InBounds  is 
Name  :  string(  1  A)  :=  "JACK"; 

Phone  :  string(  1 .7)  :=  "6725643"; 

function  Is_AlL_Upper_Case  is  new  In_Range('A7Z‘); 

function  Is^AlLLowerJCase  is  new  In_Range(’a7z’); 

function  Is_AlLDecimal  is  new  IrLRange('079’); 

begin 

if  Is-AlLUpperJCase(Name)  then . . . 
if  IsJUlJI)ecimal(Phone)  then . . . 
end  InBounds; 


[*In_Range  taken  from  Ada  Language  and  Methodology! 
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Object  Parameters 
Our  Stack  Example  Revisited 


OJ 


generic 

Size :  in  natural; 
pacakge  Stacks  is 
type  Stack  is  limited  private; 
procedure  Push(S  :  in  out  Stack;  I :  in  integer); 
procedure  Pop(S  :  in  out  Stack;  I :  out  integer); 
private 

subtype  NumberOfElements  is  integer 
range  O..Size; 
type  ElementArray  is 
array(NumberOfElements)  of  integer; 
type  Stack  is  record 
Elements  :  Element_Array; 

Top  :  NumberOfElements  0; 
end  record; 
end  Stacks; 

with  Stacks; 
procedure  StackUp  is 
package  SmallStack  is  new  Stacks(5); 
pacakge  BigStack  is  new  Stack(5000); 
begin 


end  StackUp; 


•  -  -  ■ 
»  a* ■  ** 
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Object  Parameters 
and 

Default  Values 


generic 

Rows  :  in  positive  24; 

Columns  :  in  positive  80; 
package  Terminal  is 

•  a  m 

end  Terminal; 

—  some  possible  instantiations 

package  MicroTerminal  is  new  Terminal(24,40) 

—  using  positional  notation 

package  WordProcessor  is  new 
Terminal(Columns->85,Rows->66); 

—  using  named  notation 

package  DefaultTerminal  is  new  Terminal; 

—  using  the  default  values  of  24  and  80 


Object  Parameters 
and 

The  Subtleties  of  Default  Values 


What  are  the  outputs  of  the  following? 

package  CountingPackage  is 
function  NextNum  return  integer; 

generic 

Val :  integer  :=  NextNum; 
procedure  Count; 
end  CountingPackage; 

with  TextJO; 

package  body  CountingPackage  is 
CurrentValue  :  integer  :=  0; 
function  Num  return  integer  is 
begin 

CurrentValue  :=  CurrentValue  +  1 ; 
return  CurrentValue; 
end  Num; 

procedure  Count  is 
begin 

Text  JOPutJJne(integer’image(  Val)); 
end  Count; 
end  CountingPackage; 


with  CountingPackage; 
procedure  Startcounting  is 
procedure  FirstCount  is  new  CountingPackage  .Count; 
procedure  CountAgain  is  new  CountingPackage.Count; 
begin 

FirstCount; 

CountAgain; 
end  StartCounting; 


'V 


Object  Parameters 
A  More  Useful  Example 


generic 

Control-Block  :  in  out  DeviceData; 

Kind  :  in  VDUJCind  Basic-Kind; 
package  VDU  is 
•  •  • 

end  VDU; 
with  VDU; 

procedure  ManyVDUs  is 
DeviceTable  :  array(L.N)  of  DeviceData; 

package  VDU  1  is  new 
VDU(DeviceTable(  1  ),Kind_A); 
package  VDU2  is  new 
VDU(DeviceTable(2),Kind_B); 

begin 
•  ■  • 

end  ManyVDUs; 


l*Taken  from  Ada  Language  and  Methodology] 


Object  Parameters 
and 

Subtleties 

□  Object  parameters  passed  by  reference 
not  by  copy-restore  method 

□  Object  parameters  are  "aliases"  for  their 
actual  parameter  counterparts 

Example: 


with  Text_10;  use  Text_10; 
procedure  X  is 
Global :  integer  99; 
procedure  Z(Param  :  in  out  integer)  is 
begin 

Param  Param  +  1 ; 

Put_Line(integer'image(Param)); 

Put  JLine(integer '  image(Global )) ; 
end  Z; 
begin 
Z(Global); 
end  X; 

—  output  is  100,  99  for  copy-restore  method 

—  output  is  100,100  for  pass  by  reference 
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Object  Parameters 
and 

Subtleties  cont. 

□  Object  parameters  passed  by  reference 
not  by  name  —  not  like  Algol's  "copy 
rule" 

□  Address  of  actual  parameter  corresponding 
to  formal  generic  object  parameter  is 
evaluated  ONCE  and  does  not  change 

□  Using  generic  object  parameter  NOT  like 
doing  textual  substitution  of  actual 
parameter' s  name 


*  /  f  * 


declare 

Y  :  array(1..5)  of  character  "kitty"; 
Index  :  integer  1  ; 

generic 

X  :  in  out  character; 
procedure  Replace; 


procedure  Replace  is 
begin 
Index 5; 

X:«  V;  —  X  ->  Y(l),  NOT  Y(5) 

Put(String(Y)); 
end  Replace; 

procedure  Update  is  new  Replace(Y(Index)); 
—  Index  -  1  when  this  instantiation  occurs 

begin 

Update; 

end; 


Object  Parameters 
and 

Subtleties  cont. 


□  ADDRESS  of  actual  parameter 
corresponding  to  a  generic  formal  object 
parameter  is  evaluated  at  time  of 
instantiation  —  VALUE  in  that 
address  not  evaluated  or  copied  into  the 
formal  parameter 


I 
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declare 

subtype  Small  is  integer  range  1  ..  10; 

X  :  integer  27; 
generic 
S  :  in  Small; 
procedure  Gen; 
procedure  Gen  is 
begin 

PutC  All  OK"); 
end  Gen; 

procedure  P  is  new  Gen(X); 

—  Constraint-Error  raised  at  time  of  instant, 
begin 

P; 

end; 

declare 

subtype  Small  is  integer  range  1..10; 

X  :  integer  :«  27; 
generic 

S  :  in  out  Small; 
procedure  Gen; 
procedure  Gen  is 
begin 

PutCAll  OK"); 
end  Gen; 

procedure  P  is  new  Gen(X); 

—  executes  OK  --  would  NOT  if  value  of 

S  was  used  inside  Gen 

begin 

P; 

end; 


Object  Parameters 


□  Use  not  recommended  because  suffer 
from  all  same  falacies  as  global  objects 

□  Generic  object  parameters  usually 
SHOULD  have  been  regular  formal 
parameters  in  the  subprogram 


Object  Parameters  cont. 


generic 

Variable  :  in  out  integer; 

Limit,  ResetValue  :  in  integer; 
procedure  ResetlntegerTemplate; 

procedure  ResetlntegerTemplate  is 
begin 

if  Variable  >  Limit  then 
Variable  ResetValue; 
end  if; 

end  ResetlntegerTemplate; 

Better  written  as  . . . 
generic 

Limit,  ResetValue  :  in  integer; 
procedure  ResetIntegerTemplate(Variable  :  in  out 
integer); 

procedure  ResetlntegerTemplate(Variable  :  in  out 
integer)  is 
begin 

if  Variable  >  Limit  then 
Variable  ResetValue; 
end  if; 

end  ResetlntegerTemplate; 


Type  Parameters 


0  type  identifier  is  range  <>; 

□  type  identifier  is  digits  <>; 

□  type  identifier  is  delta  <>; 

□  type  identifier  is  (<>); 

□  type  identifier  is  array(  typemark 

....  typemark  range  <>)  of  typemark, 

□  type  identifier  is  array(  typemark, .... 

typemark)  of  typemark, 

□  type  identifier  is  access  typemark, 

□  type  identifier  is  private; 

□  type  identifier  is  limited  private; 


Integer  Type  Parameters 


□  type  identifier  is  range  <>; 

□  matches  an  integer  type,  predefined  or 
user-defined 

□  operations  defined  are  those  defined  for 

integers  such  as  rem,  mod, 

negation,  abs,  >,  <,  -,  /-,  <-,  >- 

□  attributes  defined  are  those  defined  for 
integers  such  as  first,  last,  succ, . . . 


Integer  Type  Parameters 
An  Example 


generic 

type  IntType  is  range  <>; 
function  Increment^  :  IntType)  return  IntType; 

function  Increment(X:IntType)  return  IntType  is 
begin 

return  X+ 1 ; 
end  Increment; 

with  Increment; 
procedure  IncrementThings  is 

type  Age  is  range  0  ..  130; 
type  Temp  is  range  -100..  100; 

MyAge :  Age  30; 

CurrentTemp  :  Temp  80; 

function  YearOlder  is  new  Increment(Age); 
function  TempUp  is  new 

Increment!  IntType-  >Temp ); 

begin 

MyAge YearOlder(MyAge); 

CurrentTemp TempUp(CurrentTemp); 
end  IncrementThings; 


Float  Type  Parameters 

□  type  identifier  is  digits  <>; 

□  matches  any  floating  point  type,  predefined 
or  user-defined 

□  operations  defined  are  those  available  for 

floating  point  types  such  as  +,  /,  *, 

**,  negation,  abs,  >,  <,  -,  /-,  <-,  >« 

□  attributes  defined  are  those  available  for 
floating  point  types  such  as  small,  large, 
digits,  mantisa,  epsilon,  . . . 

□  useful  in  providing  mathematical  routines 
where  user  can  control  the  precision  used 


Float  Type  Parameters 
An  Example 


generic 

type  FloatType  is  digits  <>; 
function  Sqrt(X  :  FloatType)  return  FloatType; 

function  Sqrt(X  :  FloatType)  return  FloatType  is 
begin 
•  «  < 

end  Sqrt; 
with  Sqrt; 

procedure  Rooting  is 

type  VeryPrecise  is  digits  7; 
type  Imprecise  is  digits  3; 

X  :  VeryPrecise  0.1234; 

Y  :  Imprecise  0.12; 

function  ExactRoot  is  new  Sqrt(VeryPrecise); 
function  RoundRoot  is  new  Sqrt(Imprecise); 

begin 

X  ExactRoot(X); 

Y  RoundRoot(Y); 
end  Rooting; 
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Discrete  Type  Parameters 


□  type  identifier  is  (<>); 

□  matches  any  discrete  type  —  includes 
integer  types  and  enumeration  types 
(boolean  also) 

□  attributes  defined  are  those  available  for 
any  discrete/scalar  type  such  as  first, 
last,  succ,  'pred,  image,  value,  pos, 
val 

□  operations  defined  are  those  defined  for 
discrete/scalar  types  such  as  >,  <,  -,  /-, 

>-,  <- 


,  v  *v.v.  S  V 
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Discrete  Type  Parameters 
An  Example 


generic 

type  Element  is  (<>); 
package  Sets  is 
type  Set  is  private; 

function  Intersection(Sl,S2  :  Set)  return  Set; 
function  Union(Sl,S2  :  Set)  return  Set; 
function  Isln(ltem  :  Element;  S  :  Set)  return 
boolean; 

function  IsNull(S  :  Set)  return  boolean; 
private 

type  Set  is  array(Element)  of  boolean; 
end  Sets; 


—  some  possible  instantiations 

package  CharacterSet  is  new  Sets(character); 

package  IntegerSet  is  new  Sets(integer); 

type  Student  is  (John,  Joan,  Ann,  Sue . Zip); 

package  StudentSet  is  new  Sets(Student); 


Discrete  Type  Parameters  cont. 


□  Minimal  assumptions  about  the  type 
must  be  made  -  operations  must  apply 
to  ALL  discrete  types 


Example: 

generic 

type  Element  is  (<>); 

function  Next(X  :  Element)  return  Element; 

function  Next(X  :  Element)  return  Element  is 
begin 

X  X  +  1;  --not  defined  for  ALL 

—  discrete  types 

end  Next; 

Use  attributes; 

function  Next(X  :  Element)  return  Element  is 
begin 

if  X  -  Element' Last  then 
return  Element'First; 
else 

return  Element'Succ(X); 
end  if; 
end  Next; 


Constrained  Array  Type  Parameters 

O  type  identifier  is  array  ( typemark, .... 
typenark)  of  typemark 

□  matches  any  constrained  array  type 
where: 

1)  number  of  dimensions  match, 

2)  index  subtypes  of  corresponding 
dimensions  match, 

3)  bounds  in  corresponding  dimensions 
are  identical, 

4)  component  types  match 

□  attributes  defined  are  those  available  for 
constrained  arrays  such  as  'first(n), 
'last(n),  'range(n),  'length(n) 

□  operations  defined  include  those  available 
for  constrained  arrays  such  as  -, using 
slice  notation  (for  one  dimensional  arrays) 


Constrained  Array  Type  Parameters 

An  Example 

generic 

type  Component  is  (<>); 
type  AnArray  is  array(1..10)  of  Component; 
procedure  Sort(A  :  in  out  AnArray); 
procedure  Sort(A  :  in  out  AnArray)  is 
Temp  :  Component; 
begin 

for  I  in  2  ..  10  loop 
for  J  in  1..I-1  loop 
if  A(I)<  A(J)  then 
Temp  A(J); 

A(J) A(I); 

A(I) Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort; 

—  in  user  program 

type  Age  is  integer  range  0..130; 

type  AgeArray  is  array(1..10)  of  Age; 

X  :  AgeArray  (8,0,9,4,50,35,87,97,1,124); 

procedure  AgeSort  is  new 
Sort(Component,  AgeArray); 

.  . .  AgeSort(X);  .  .  . 


mm 


Unconstrained  Array  Type 
Parameters 

□  type  identifier  is  array(  tvpemarkrdSigz  <>, 

....  typemark  range  <>)  of  typemark 

□  matches  any  unconstrained  array  where: 

1)  number  of  dimensions  the  same 

2)  subtype  of  index  for  corresponding 
dimensions  is  the  same 

3)  component  types  match 

□  attributes  defined  are  those  available  for 
unconstrained  arrays  such  as  'first(n), 
last(n),  range(n),  length(n) 

□  operations  defined  include  those  available 
for  unconstrained  arrays  such  as  «, 
using  slice  notation  (for  one  dimensional 
typearrays) 


Unconstrained  Array  Type 
Parameters 
An  Example 


generic 

type  Index  is  range  o; 
type  Component  is  range  <>; 
type  AnArray  is  array(Index)  of  Component; 
procedure  Sort(A  :  in  out  AnArray); 
procedure  Sort(A  :  in  out  AnArray)  is 
Temp  :  Component; 
begin 

for  I  in  A  First+ 1  ..  A  Last  loop 
for  J  in  A'First ..  1-1  loop 
if  A(I)  <  A(J)  then 
Temp  A(J); 

A(J)  A(I); 

A(I)  Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort; 


—in  user  s  program 
type  Age  is  range  0..  1 30; 
type  EmpioyeeNumber  is  range  1..100; 
type  EmpList  is  array(EmployeeNumber)  of  Age; 
procedure  Employ eeAgeSort  is  new 
Sort(EmployeeNumber,  Age,  EmpList); 
Employees  :  EmpList .); 


. .  ,  EmployeeAgeSort(Employees); . . . 


.  wvy,  <_  ■r.  ■r.  s ,  r,  c  *- 


■ 


WWW 


Private  Type  Parameters 


□  type  identifier  is  private; 

□  matches  any  type  except  a  limited  type 

□  operations  available  are  only  declaring 
objects  of  the  type,  testing  for  equality 
and  inequality,  and  assigning  values  to 
objects  of  the  type 


Private  Type  Parameters 
An  Example 


generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  AnArray  is  array(Index)  of  Component; 
function  Found(A  :  AnArray;  T  :  Component) 
return  boolean; 

function  Found(A  :  AnArray;  T  :  Component) 
return  boolean  is 
begin 

for  I  in  A'First..A‘Last  loop 
if  A(I)  -  T  then 
return  TRUE; 
end  if; 
end  loop; 
return  FALSE; 
end  Found; 


? 


—in  user's  program 

type  Student  is  (Joan, John, Sue Debbie); 

type  Grade  is  range  0..100; 

type  GradeArray  is  array(Student)  of  Grade; 

function  GradeMade  is  new 

Found  (Student, Grade, GradeArray); 
Grades  :  GradeArray  :-(... .); 


...  if  GradeMade(Grades.lOO)  then  . . . 


Private  Type  Parameters  cont. 

and 

Restrictions  Imposed 

What's  wrong  here? 
generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  InL-Array  is  array(Index)  of  Component; 
procedure  Sort_Array(Arr  :  in  out  Int_Array); 

procedure  Sort_Array(Arr  :  in  out  Int_Array)  is 
Temp  :  Component; 
begin 

for  I  in  Index,Succ(Arr'First)..Arr,Last  loop 
for  J  in  Arr'First..Index’Pred(I)  loop 
if  Arr(I)  <  Ar(J)  then 
Temp  Arr(J); 

Arr(J) Arr(I); 

Arr(I) Temp; 
end  if; 
end  loop; 
end  loop; 
end  Sort-Array; 


Private  Type  Parameters 
Another  Caution 

What’s  wrong  here? 
generic 

type  Element  is  private; 
procedure  Swap(X,Y  :  in  out  Element); 

procedure  Swap(X,Y  :  in  out  Element)  is 
Temp  :  Element; 
begin 
Temp  X; 

X  Y; 

Y  Temp; 
end  Swap; 

—  in  user  s  program 

HerName  :  string(1..5) "Lindy"; 

HisName  :  string(1..5)  "Chuck"; 

procedure  NameSwap  is  new  Swap(string); 


Limited  Private  Type  Parameters 


□  matches  any  type  including  a  limited 
type 

□  only  declaration  of  objects  of  the  type 
permitted  and  NOTHING  else 

Example: 

generic 

MyFile  :  Text_IO.File_Type;  —  illegal 
procedure  Oops; 


Access  Type  Parameters 


□  matches  any  access  type 

□  operations  defined  for  access  types 
available  such  as  setting  object  to  null, 
use  of  NEW  allocator,  use  of  .ALL  notation 

—  Example  follows  introduction  of 
subprogram  parameters 


Generic  Formal  Type  Parameters 

A  Synopsis 

Generic  formal  parameter  Actual  parameter 


V.-v- 


type  T  is  limited  private; 
type  T  is  private; 
type  T  is  (<>); 
type  T  is  rangeo; 
type  T  is  digits  <>; 
type  T  is  delta  <>; 


any  type 

any  non-limited  type 
any  discrete  type 
any  integer  type 
any  float  type 
any  fixed  point  type 


v.v 


(•Taken  from  Ada  Language  and  Methodoiogyl 


Type  Parameters 
and 

The  Standard  Generic  10  Packages 


package  TextJO  is 

. . .  non-  generic  part  of  Text_IO 
generic 

type  NUM  is  range  <>; 
package  IntegerJO  is 
•  •  • 

end  Integer_IO; 
generic 

type  NUM  is  digits  <>; 
pacakge  Float_IO  is 

a  •  I 

end  Float-JO; 
generic 

type  NUM  is  delta  <>; 
package  Fixed  JO  is 
0  •  • 

end  FixedJO; 
generic 

type  ENUM  is  (<>); 
package  Enumeration_IO  is 
•  •  • 

end  Enumeration-IO; 
end  Text_IO; 


Generic  Formal  Type  Parameters 
How  To  Choose? 


□  What  operations  are  performed  on  the 
type  in  the  generic  body? 

□  How  restrictive  on  the  type  that  the  user 
can  choose  do  you  want  to  be? 


Subprogram  Parameters 


□  allow  definition  and  "pass  in"  of 
additional  operations  for  generic 
formal  type  parameters  -  especially 
private  and  limited  private  types 

□  can  pass  functions  or  procedures 

□  formal  parameters  of  generic  formal 
subprogram  parameter  are  checked  to 
ensure  match  with  actual  parameters 
in  a  call  to  that  subprogram  at  compile 


Subprogram  Parameters 

and 

A  Pascal  Flaw  Resolved 

program  P; 

type  Color  -  (Red, Green, Blue); 
var  Bucket :  Color; 

procedure  Print(C :  Color); 
begin 
case  C  of 

Red  :  writeln('Red '); 

Green :  writeln('Green'); 

Blue :  writeln('Blue); 
end  case; 
end; 

procedure  Proc(P :  procedure); 
begin 

P(Bucket);  (*  OK  *) 

P(5);  (*  RUNtime  error 

end; 


begin 

Proc(Print); 


Subprogram  Parameters 
A  Pascal  Flaw  Resolved  cont. 

declare 

type  Color  is  (Red, Green, Blue); 

Bucket :  Color  Green; 

procedure  Print(C  :  in  Color)  is 
begin 

Text_IO.Put(Color'Image(C)); 
end  Pring; 

generic 

with  procedure  P(Val :  Color); 
procedure  Gen_Proc; 

procedure  Gen_Proc  is 
begin 

P(Bucket);  —  OK 
P(5);  -  COMPILE  time  error 

end  Gen_Proc; 


Subprogram  Parameters 
An  Example 


generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  Int_Array  is  array(Index)  ot  Component; 
with  function  "<  "(X,Y:Component) 
return  boolean; 

procedure  Sort_Array(Arr  :  in  out  Int_Array); 

procedure  Sort_-Array(Arr  :  in  out  Int_Array)  is 
Temp  :  Component; 
begin 

for  I  in  Index'Succ(Arr'First)..Arr'Last  loop 
for  J  in  Arr'First..Index'Pred(I)  loop 
if  Arr(I)  <  Ar(J)  then 
Temp  Arr(J); 

Arr(J)  Arr(I); 

Arr(I) Temp; 
end  if; 
end  loop  ; 
end  loop; 
end  Sort-Array; 


pfv 
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Subprogram  Parameters 
An  Example  cont. 


type  Day  is  range  1..31; 
type  WeatherRec  is  record 
RainFall :  natural; 

AvgTemp  :  float; 
end  record; 

type  WeatherArray  is  array(Day)  of  WeatherRec; 

function  LT(X,Y:  WeatherRec)  return  boolean  is 
begin 

return  X.Rainfall  >  Y.Rainfall; 
end  LT; 

function  "<"(X,Y :  WeatherRec)  return  boolean  is 
begin 

return  X.AvgTetnp  >  Y.AvgTemp; 

end  ”<”; 

procedure  RainSort  is  new  Sort_Array(Day, 
WeatherRec,  WeatherArray,  LT); 


procedure  TempSort  is  new  Sort-Array 
(Index- >Day,  Component->WeatherRec, 
Int_Array->WeatherArray,,‘<"->"<"); 

WeatherData :  WeatherArray :-(....); 
begin 

RainSort(WeatherData); 
TempSort(WeatherData);  . . .  end; 
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Subprogram  Parameters 

and 

Default  Values 


generic 

type  Index  is  (<>); 
type  Component  is  private; 
type  Int_Array  is  array(Index)  of  Component; 
with  function  V(X,Y:Component) 
return  boolean  is  <>; 

procedure  SorL_Array(Arr  :  in  out  Int_Array); 


—in  user  s  program 

function  V(X,Y  :  WeatherRec)  return  boolean  is 
begin 

return  X.AvgTemp  >  Y.AvgTemp; 
end  V; 

procedure  DefaultSort  is  new  Sort-Array 
(Index-  >Day,  Component-  >WeatherRec , 

I  nt-A  r  r  ay- >Weat  her  A  r  ray ) ; 


. . .  DefaultSort(WeatherData);  —  will  sort  on 

—  temp  values 


Subprogram  Parameters 

and 

Default  Values  cont. 


Another  example: 

type  Small  Range  is  range  1..10; 

type  Values  is  array(SmallRange)  of  integer; 

procedure  IntegerSort  is  new  Sort-Array 
(Index- >Smal IRange,  Component- integer, 
Int_Array«>Values); 

—  default  >  for 


V  :  Values  .); 
begin 

IntegerSort(V);  —  default  "<"  for  integers  used 
end; 

—  using  Put  for  subprogram  parameter  name 

—  results  in  default  to  generic  Put  routines 

—  in  the  10  packages 


Subprogram  Parameters 

and 

Subtleties  of  Default  Values 


□  Global  references  inside  a  generic  are 
resolved  to  those  at  point  of  DECLARATION. 

□  For  subprogram  parameters,  default 
references  resolve  to  matching  names  from 
point  of  INSTANTIATION. 
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with  Text_IO;  use  Text_IO; 
package  Shell  is 
Global :  integer  17; 
generic 

with  procedure  Put(Val :  integer)  is  <>; 
procedure  Demo; 
end  Shell; 

package  body  Shell  is 
procedure  Demo  is 
begin 

Put(Global); 
end  Demo; 
end  Shell; 


with  Shell; 
package  Inner  is 
Global :  integer  39; 
procedure  Put(I :  integer); 

procedure  User  is  new  Shell.Demo; 
end  Inner; 


with  Text_IO; 
package  body  Inner  is 
procedure  Put(I ;  integer)  is 
begin 

Text_IO.Put(  "Surprise"  &  integer' image(I)); 
end  Put; 
end  Inner; 


Subprogram  Parameters 

and 

Access  Type  Parameters 
An  Example 

generic 

type  KeyType  is  private; 
type  ElementType  is  private; 
with  function  "<" (Left, Right :  KeyType) 
return  boolean  is  <>; 
package  BinaryTreeMaker  is 
type  Kind  is  private; 
function  Make  return  Kind; 
function  IsEmpty(T  :  Kind)  return  boolean; 
procedure  lnsert(T  :  in  out  Kind; 

K  :  KeyType; 

E ;  ElementType); 

function  Retrieve(T  ;  Kind;  K  :  KeyType) 
return  ElementType; 

KeyNotFound  :  exception; 

generic 

with  procedure  Operation(K  :  KeyType; 

E :  ElementType); 

procedure  lnorderTraverse(TheTree:  in  Kind); 
private 

type  InternalRecord; 
type  Kind  is  access  InternalRecord; 
end  BinaryTreeMaker; 


with  BinaryTreeMaker; 
package  EmployeeDataBase  is 
NameLength  :  constant 40; 
subtype  NameType  is  string(l.. NameLength); 
type  Dollar  is  delta  0.01  range  0.0..1.0e8; 
type  AgeType  is  range  0  ..  150; 
type  YearType  is  range  1900..2100; 
type  Employeelnfo  is  record 
Salary :  Dollar; 

Age :  AgeType; 

Hired  :  YearType; 
end  record; 

package  EmployeeTree  is  new 

BinaryTreeMaker(KeyType->NameType, 

ElementType->EmployeeInfo); 

RootNode :  EmployeeTree.Kind; 
end  EmployeeDataBase; 
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with  EmployeeDataBase;  use  EmployeeDataBase; 
with  Text_IO;  use  Text_IO; 
procedure  PrintReports  is 

package  SalarylO  is  new  Fixed-IO(Dollar); 
package  AgelO  is  new  lnteger_IO(AgeType); 
use  SalarylO,  AgelO; 


procedure  PrintSalary(Key :  NameType; 

Info :  Employeelnfo)  is 
begin 

. . .  Put(lnfo.Salary); 
end; 


procedure  Print  Age(Key  :  NameType; 

Info :  Employeelnfo)  is 
begin 

. . .  Put(Info.Age); 
end; 


procedure  ReportSalaries  is  new 
EmployeeTree.InorderTraverse 
(Operation-)  PrintSalary); 


procedure  ReportAge  is  new 
Emp  loyeeT  ree.  InorderTraverse 
(Operation-)  PrintAge); 

begin 

ReportSalaries(RootNode); 

New_Line; 

Report  Ages  (RootN  ode); 

end  PrintReports; 

(•From  Understanding  Ada  ] 


Subprogram  Parameters 

and 

Handling  Exceptions 


generic 

package  Stack  is 
. . .  same  as  before 

Overflow,  Underflow :  exception; 
end  Stack; 

—  in  user's  program 

package  SI  is  new  Stack; 
package  S2  is  new  Stack; 

begin 

51. Push(5); 

52. Pop(Item); 
exception 

when  SI. Underflow 
when  SI. Overflow  ->...; 
when  S2.Underflow  ->...; 
when  S2.0verflow  -> . . .; 
end; 
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Subprogram  Parameters 

and 

Handling  Exceptions  cont. 

□  Cannot  pass  exceptions  as  generic  parameter 


generic 

When__Error  :  exception;  —  NOT  allowed 

i  «  i 

procedure  X  . . . 

•  •  • 

exception 

when  others  ->  raise  When_Error; 
end  X; 


My  -Exception :  exception; 
procedure  S  is  new  X(My_Exception); 


begin 


exception 

when  My_Exception  -> 
end; 


—  NOT  allowed 


Subprogram  Parameters 

and 

Handling  Exceptions  cont. 


generic 

with  procedure  OverflowHandler; 
package  Stack  is 
. . .  same  as  before; 
end  Stack; 

package  body  Stack  is 

.  . .  in  Push  procedure  . . . 
when  Constraint_Error  ->  OverflowHandler; 

end  Stack; 

—  in  user  program 
with  Stack; 

•  *  • 

procedure  OverflowHandler  is 
begin 

Text_IO.Put_Line("Overflow  has  occurred"); 
end  OverflowHandler; 

package  SI  is  new  Stack(OverflowHandler); 

begin 
•  •  • 

Sl.Push(5);  —  if  overflow  occurs  msg  prints 


Generic  Can'ts 


□  No  generic  SUBtype  parameters,  only  TYPEs 


□  No  generic  record  types 

□  No  generic  tasks 

□  Wrap  a  package  around  it 


What  are  the  Cons  of  Generics? 


□  Takes  longer/is  harder  to  write  generic  code 

□  Usually  some  efficiency  sacrificed  for 
the  generality  —  use  of  application 
specifics  could  lead  to  increased  efficiency 

□  Difficult  to  make  component  robust/reliable 
enough  to  survive  all  uses 


What  are  the  Pros  of  generics? 


□  Reusability  -  no  reinventing  the  wheel 
for  each  specific  application 

□  Levels  of  abstraction  added  -  separation 
of  abstraction  and  implementation 

□  Source  code  size  of  user  programs  reduced 

□  Maintainability,  readability,  and 
understandability  increased 

□  Verification  more  manageable 

□  When  used  in  conjunction  with  user-defined 
types  increases  portability  across  machines 

□  Provides  necessary  answer  to  strong  typing 
without  sacrificing  increased  reliability  of 
compile  time  checks 

□  Provides  flexible  10  packages  which  can 
be  used  (if  needed)  for  predefined  AND 
user-defined  types 


Unresolved  Issues  in  Generics 


□  Compiler  Issues 

□  Use  "code  sharing"  or  "code  copying"  to 
implement  generics 

□  Management  Issues 

□  How  to  facilitate  creation  of  generic  units 

□  In  retrospect,  after  recognizing 
similarity  in  produced  units 

□  Beforehand  using  "domain  analysis" 

□  How  to  manage  storage  and  retrieval 
of  units  in  a  library  of  generic  units 

□  How  to  "publicize"  availability  of 
units  in  generic  library  and  provide 
criterion  for  selecting  proper  unit 

□  How  to  manage  updating  of  used  generic 
units  as  "bugs"  are  uncovered 

□  Legal  Issues 

□  Who  owns  the  generic  module 

□  Who  is  liable  for  the  generic  module's 
performance 


[*See  Software  Components  with  Ada] 


How  do  you  TEACH  generics? 


□  Necessary  as  10  is  an  issue  arising  early 
and  should  not  be  kept  a  'magic’’  process 

□  One  key  is  to  use  concrete  examples 

□  Driver's  licence  form  is  a  generic 
template  —  individual's  license  is 
a  usable  instantiation 

□  One  key  is  to  tie  to  previous  learning 

□  Use  old/familiar  packages,  procedures, 
and  functions  -  Stacks,  Swap,  etc. 


